From c4ab53870607fae0de0deafd4ee8b2bcad93f558 Mon Sep 17 00:00:00 2001 From: perturbing Date: Tue, 18 Aug 2026 09:18:21 +0200 Subject: [PATCH 1/5] fix bls PoP DST as per IETF --- cardano-crypto-class/CHANGELOG.md | 6 +++ .../bench/Bench/Crypto/DSIGN.hs | 17 +++---- .../Cardano/Crypto/DSIGN/BLS12381/Internal.hs | 50 +++++++++++++++---- .../src/Cardano/Crypto/DSIGN/Class.hs | 9 +--- .../testlib/Test/Crypto/DSIGN.hs | 22 ++++---- 5 files changed, 67 insertions(+), 37 deletions(-) diff --git a/cardano-crypto-class/CHANGELOG.md b/cardano-crypto-class/CHANGELOG.md index b383d749c..339b70b61 100644 --- a/cardano-crypto-class/CHANGELOG.md +++ b/cardano-crypto-class/CHANGELOG.md @@ -4,6 +4,12 @@ * Replace memory dependency with ram (drop in replacement) * Depend on crypton ^>- 1.1 +* Fix the DST used when hashing the public key for BLS12-381 proofs of possession: + `createPossessionProofDSIGN` and `verifyPossessionProofDSIGN` now use the + `"BLS_POP_"`-prefixed DST prescribed by draft-irtf-cfrg-bls-signature-06 + (Section 4.2.3) instead of the `"BLS_SIG_"` one used for ordinary signatures. + The PoP DST is selected internally per curve variant, so these functions (and + `aggregateVerKeysDSIGN`) no longer take a signing context. ## 2.5.1.0 diff --git a/cardano-crypto-class/bench/Bench/Crypto/DSIGN.hs b/cardano-crypto-class/bench/Bench/Crypto/DSIGN.hs index 26094d844..4ba3ddf6b 100644 --- a/cardano-crypto-class/bench/Bench/Crypto/DSIGN.hs +++ b/cardano-crypto-class/bench/Bench/Crypto/DSIGN.hs @@ -139,15 +139,15 @@ benchAggDSIGN _ lbl = [ bgroup ("n=" <> show n) [ env (pure (mkCase @v ctx msg n)) $ \c -> bench "provePoP (all)" $ - nf (proveAllPoPs @v ctx) (caseSKs c) + nf (proveAllPoPs @v) (caseSKs c) , env (pure (mkCase @v ctx msg n)) $ \c -> bench "verifyPoP (all)" $ - nf (verifyAllPoPs @v ctx) (caseVKPoPs c) + nf (verifyAllPoPs @v) (caseVKPoPs c) , env (pure (mkCase @v ctx msg n)) $ \c -> bench "aggregateVerKeys (with PoPs)" $ - nf (aggregateVerKeysDSIGN @v ctx) (caseVKPoPs c) + nf (aggregateVerKeysDSIGN @v) (caseVKPoPs c) , env (pure (mkCase @v ctx msg n)) $ \c -> bench "aggregateVerKeys (no PoPs)" $ @@ -184,17 +184,16 @@ mkCase :: forall v a. (DSIGNAggregatable v, Signable v a) mkCase ctx msg n = let sks = replicate n (genKeyDSIGN @v testSeed) vks = map deriveVerKeyDSIGN sks - pops = map (createPossessionProofDSIGN @v ctx) sks + pops = map (createPossessionProofDSIGN @v) sks sigs = map (signDSIGN @v ctx msg) sks vkp = zip vks pops in AggCase sks vks vkp sigs proveAllPoPs :: forall v. DSIGNAggregatable v - => ContextDSIGN v -> [SignKeyDSIGN v] -> [PossessionProofDSIGN v] -proveAllPoPs ctx = map (createPossessionProofDSIGN @v ctx) + => [SignKeyDSIGN v] -> [PossessionProofDSIGN v] +proveAllPoPs = map (createPossessionProofDSIGN @v) verifyAllPoPs :: forall v. DSIGNAggregatable v - => ContextDSIGN v - -> [(VerKeyDSIGN v, PossessionProofDSIGN v)] + => [(VerKeyDSIGN v, PossessionProofDSIGN v)] -> Either String () -verifyAllPoPs ctx = F.foldl' (\acc (vk,pop) -> acc >> verifyPossessionProofDSIGN @v ctx vk pop) (Right ()) +verifyAllPoPs = F.foldl' (\acc (vk,pop) -> acc >> verifyPossessionProofDSIGN @v vk pop) (Right ()) diff --git a/cardano-crypto-class/src/Cardano/Crypto/DSIGN/BLS12381/Internal.hs b/cardano-crypto-class/src/Cardano/Crypto/DSIGN/BLS12381/Internal.hs index f2e002051..c60153d29 100644 --- a/cardano-crypto-class/src/Cardano/Crypto/DSIGN/BLS12381/Internal.hs +++ b/cardano-crypto-class/src/Cardano/Crypto/DSIGN/BLS12381/Internal.hs @@ -98,10 +98,11 @@ import Data.Bifunctor (first) import Data.ByteString (ByteString) import qualified Data.ByteString as BS import Data.ByteString.Unsafe (unsafeUseAsCStringLen) -import Data.Data (Typeable) +import Data.Data (Typeable, eqT) import qualified Data.Foldable as F (foldl') import Data.Kind (Type) import Data.Proxy (Proxy (Proxy)) +import Data.Type.Equality ((:~:) (Refl)) import Foreign.C.Types import GHC.Generics (Generic) import GHC.TypeLits (KnownSymbol, Symbol, symbolVal) @@ -133,6 +134,29 @@ minSigPoPDST = BLS12381SignContext (Just "BLS_SIG_BLS12381G1_XMD:SHA-256_SSWU_RO minVerKeyPoPDST :: BLS12381SignContext minVerKeyPoPDST = BLS12381SignContext (Just "BLS_SIG_BLS12381G2_XMD:SHA-256_SSWU_RO_POP_") Nothing +-- The context used by @hash_pubkey_to_point@ when creating and verifying +-- proofs of possession for the minimal signature size variant, as per +-- draft-irtf-cfrg-bls-signature-06, Section 4.2.3: proofs of possession use +-- @"BLS_POP_" || H2C_SUITE_ID || SC_TAG || "_"@ as DST, whereas ordinary +-- signatures use the @"BLS_SIG_"@ prefix. Not exported: it is applied +-- internally by 'createPossessionProofDSIGN' and 'verifyPossessionProofDSIGN', +-- so users cannot accidentally create or verify a proof under the signature +-- DST. +minSigPoPProofDST :: BLS12381SignContext +minSigPoPProofDST = BLS12381SignContext (Just "BLS_POP_BLS12381G1_XMD:SHA-256_SSWU_RO_POP_") Nothing + +-- As 'minSigPoPProofDST', for the minimal verification key size variant. +minVerKeyPoPProofDST :: BLS12381SignContext +minVerKeyPoPProofDST = BLS12381SignContext (Just "BLS_POP_BLS12381G2_XMD:SHA-256_SSWU_RO_POP_") Nothing + +-- Select the proof-of-possession context for the curve the verification keys +-- live on. +popProofSignContext :: forall curve. Typeable curve => Proxy curve -> BLS12381SignContext +popProofSignContext _ = + case eqT @curve @Curve1 of + Just Refl -> minVerKeyPoPProofDST + Nothing -> minSigPoPProofDST + type family CurveVariant (c :: Type) :: Symbol where CurveVariant Curve1 = "BLS-Signature-Mininimal-Verification-Key-Size" CurveVariant Curve2 = "BLS-Signature-Mininimal-Signature-Size" @@ -194,6 +218,14 @@ type family CurveVariant (c :: Type) :: Symbol where -- public keys live in G1 (48 bytes compressed), signatures in G2 -- (96 bytes compressed). -- +-- Within each variant, the PoP ciphersuite prescribes two DSTs (Section 4.2.3): +-- ordinary signing and verification use the @\"BLS_SIG_\"@-prefixed DST +-- ('minSigPoPDST' \/ 'minVerKeyPoPDST'), while creating and verifying proofs of +-- possession hash the public key with the @\"BLS_POP_\"@-prefixed DST. +-- 'createPossessionProofDSIGN' and 'verifyPossessionProofDSIGN' take no signing +-- context: they select the @\"BLS_POP_\"@ context internally from the curve, so +-- callers cannot accidentally use the signature DST for proofs of possession. +-- -- The draft recommends the minimal-pubkey-size variant for aggregation, -- because the size of @(PK_1, ..., PK_n, signature)@ is usually dominated by -- the public keys. Other protocols, like Leios, might favor minimal-signature-size. @@ -223,14 +255,14 @@ type family CurveVariant (c :: Type) :: Symbol where -- (mkSeedFromBytes (BS.replicate 32 2)) -- vk1 = deriveVerKeyDSIGN sk1 -- vk2 = deriveVerKeyDSIGN sk2 --- pop1 = createPossessionProofDSIGN ctx sk1 --- pop2 = createPossessionProofDSIGN ctx sk2 +-- pop1 = createPossessionProofDSIGN sk1 +-- pop2 = createPossessionProofDSIGN sk2 -- :} -- --- >>> verifyPossessionProofDSIGN ctx vk1 pop1 +-- >>> verifyPossessionProofDSIGN vk1 pop1 -- Right () -- --- >>> verifyPossessionProofDSIGN ctx vk2 pop2 +-- >>> verifyPossessionProofDSIGN vk2 pop2 -- Right () -- -- -- Once the proofs have been checked, it is safe to aggregate keys @@ -540,15 +572,15 @@ instance else Right $ SigBLS12381 aggrPoint {-# INLINE createPossessionProofDSIGN #-} - createPossessionProofDSIGN ctx sk = + createPossessionProofDSIGN sk = let vk = deriveVerKeyDSIGN sk :: VerKeyDSIGN (BLS12381DSIGN curve) - SigBLS12381 sig = signDSIGN ctx (rawEncodeFixedSized vk) sk + SigBLS12381 sig = signDSIGN (popProofSignContext (Proxy @curve)) (rawEncodeFixedSized vk) sk in PossessionProofBLS12381 sig {-# INLINE verifyPossessionProofDSIGN #-} - verifyPossessionProofDSIGN ctx vk (PossessionProofBLS12381 mu1Psb) = + verifyPossessionProofDSIGN vk (PossessionProofBLS12381 mu1Psb) = first (const "verifyPossessionProofDSIGN: BLS12381DSIGN failed to verify.") - (verifyDSIGN ctx vk (rawEncodeFixedSized vk) (SigBLS12381 mu1Psb)) + (verifyDSIGN (popProofSignContext (Proxy @curve)) vk (rawEncodeFixedSized vk) (SigBLS12381 mu1Psb)) deriving stock instance BLS (DualCurve curve) => diff --git a/cardano-crypto-class/src/Cardano/Crypto/DSIGN/Class.hs b/cardano-crypto-class/src/Cardano/Crypto/DSIGN/Class.hs index c40745eaf..2d22936d4 100644 --- a/cardano-crypto-class/src/Cardano/Crypto/DSIGN/Class.hs +++ b/cardano-crypto-class/src/Cardano/Crypto/DSIGN/Class.hs @@ -552,14 +552,12 @@ class -- | Create a PoP from the signing key. createPossessionProofDSIGN :: HasCallStack => - ContextDSIGN v -> SignKeyDSIGN v -> PossessionProofDSIGN v -- | Verify that PoP matches the verification key. verifyPossessionProofDSIGN :: HasCallStack => - ContextDSIGN v -> VerKeyDSIGN v -> PossessionProofDSIGN v -> Either String () @@ -577,16 +575,13 @@ class -- | Aggregate multiple verification keys into a single verification key given -- their corresponding Proofs of Possession. --- --- Note that the signing context is passed since the PoP might depend on it. aggregateVerKeysDSIGN :: (HasCallStack, DSIGNAggregatable v) => - ContextDSIGN v -> [(VerKeyDSIGN v, PossessionProofDSIGN v)] -> Either String (VerKeyDSIGN v) -aggregateVerKeysDSIGN ctx verKeysAndPoPs = do +aggregateVerKeysDSIGN verKeysAndPoPs = do -- Verify every verKey and its PoP (fail-fast) - forM_ verKeysAndPoPs $ uncurry (verifyPossessionProofDSIGN ctx) + forM_ verKeysAndPoPs $ uncurry verifyPossessionProofDSIGN uncheckedAggregateVerKeysDSIGN (map fst verKeysAndPoPs) possessionProofSizeDSIGN :: forall v proxy. DSIGNAggregatable v => proxy v -> Word diff --git a/cardano-crypto-class/testlib/Test/Crypto/DSIGN.hs b/cardano-crypto-class/testlib/Test/Crypto/DSIGN.hs index 29efabfa0..c168103f9 100644 --- a/cardano-crypto-class/testlib/Test/Crypto/DSIGN.hs +++ b/cardano-crypto-class/testlib/Test/Crypto/DSIGN.hs @@ -172,13 +172,11 @@ defaultSignKeyGen = defaultPossessionProofGen :: forall v. DSIGNAggregatable v - => Gen (ContextDSIGN v) - -> Gen (KeyGenContextDSIGN v) + => Gen (KeyGenContextDSIGN v) -> Gen (PossessionProofDSIGN v) -defaultPossessionProofGen genContext genKeyCtx = do - ctx <- genContext - sk <- defaultSignKeyWithContextGen @v genKeyCtx - pure $ createPossessionProofDSIGN ctx sk +defaultPossessionProofGen genKeyCtx = do + sk <- defaultSignKeyWithContextGen @v genKeyCtx + pure $ createPossessionProofDSIGN sk -- Used for adjusting no of quick check tests -- By default up to 100 tests are performed which may not be enough to catch hidden bugs @@ -817,7 +815,7 @@ testDSIGNAggregatableWithContext _ genContext genKeyCtx genMsg name = testEnough forAllShow (genAggregateCase genContext genMsg) ppShow $ \(ctx, msg, vksPops, sigs) -> (=== Right ()) $ do sig <- aggregateSigsDSIGN @v sigs - aggVk <- aggregateVerKeysDSIGN ctx vksPops + aggVk <- aggregateVerKeysDSIGN vksPops verifyDSIGN @v ctx aggVk msg sig prop "aggregate verify negative (wrong message)" $ withNumTests 1000 . @@ -825,7 +823,7 @@ testDSIGNAggregatableWithContext _ genContext genKeyCtx genMsg name = testEnough forAllShow arbitrary ppShow $ \msg' -> msg /= msg' ==> (=/= Right ()) $ do sig <- aggregateSigsDSIGN @v sigs - aggVk <- aggregateVerKeysDSIGN ctx vksPops + aggVk <- aggregateVerKeysDSIGN vksPops verifyDSIGN @v ctx aggVk msg' sig prop "aggregate verify negative (wrong PoP)" $ forAllShow (genAggregateCaseAtLeast2 genContext genMsg) ppShow $ @@ -834,7 +832,7 @@ testDSIGNAggregatableWithContext _ genContext genKeyCtx genMsg name = testEnough (a:b:rest) -> (=/= Right ()) $ do let vksPops' = (fst a, snd b) : (fst b, snd a) : rest sig <- aggregateSigsDSIGN @v sigs - aggVk <- aggregateVerKeysDSIGN ctx vksPops' + aggVk <- aggregateVerKeysDSIGN vksPops' verifyDSIGN @v ctx aggVk msg sig _ -> counterexample "genAggregateCaseAtLeast2 produced <2 entries (bug in generator)" False @@ -850,7 +848,7 @@ testDSIGNAggregatableWithContext _ genContext genKeyCtx genMsg name = testEnough => (PossessionProofDSIGN v -> prop) -> Property forAllPoP = - forAllShow (defaultPossessionProofGen @v genContext genKeyCtx) ppShow + forAllShow (defaultPossessionProofGen @v genKeyCtx) ppShow genAggregateCase genCtx genMsg' = do ctx <- genCtx msg <- genMsg' @@ -859,7 +857,7 @@ testDSIGNAggregatableWithContext _ genContext genKeyCtx genMsg name = testEnough n <- Gen.chooseInt (1, 8) sks <- replicateM n (defaultSignKeyWithContextGen @v genKeyCtx) let vksPops = [ ( deriveVerKeyDSIGN sk - , createPossessionProofDSIGN ctx sk + , createPossessionProofDSIGN sk ) | sk <- sks ] @@ -874,7 +872,7 @@ testDSIGNAggregatableWithContext _ genContext genKeyCtx genMsg name = testEnough n <- Gen.chooseInt (2, 8) sks <- replicateM n (defaultSignKeyWithContextGen @v genKeyCtx) let vksPops = [ ( deriveVerKeyDSIGN sk - , createPossessionProofDSIGN ctx sk + , createPossessionProofDSIGN sk ) | sk <- sks ] From 30a51d904f42e16b95dbcd20e4df2a7fade2b454 Mon Sep 17 00:00:00 2001 From: perturbing Date: Tue, 18 Aug 2026 10:45:24 +0200 Subject: [PATCH 2/5] Fix typo in curve variants --- .../src/Cardano/Crypto/DSIGN/BLS12381/Internal.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cardano-crypto-class/src/Cardano/Crypto/DSIGN/BLS12381/Internal.hs b/cardano-crypto-class/src/Cardano/Crypto/DSIGN/BLS12381/Internal.hs index c60153d29..c63319dc6 100644 --- a/cardano-crypto-class/src/Cardano/Crypto/DSIGN/BLS12381/Internal.hs +++ b/cardano-crypto-class/src/Cardano/Crypto/DSIGN/BLS12381/Internal.hs @@ -158,8 +158,8 @@ popProofSignContext _ = Nothing -> minSigPoPProofDST type family CurveVariant (c :: Type) :: Symbol where - CurveVariant Curve1 = "BLS-Signature-Mininimal-Verification-Key-Size" - CurveVariant Curve2 = "BLS-Signature-Mininimal-Signature-Size" + CurveVariant Curve1 = "BLS-Signature-Minimal-Verification-Key-Size" + CurveVariant Curve2 = "BLS-Signature-Minimal-Signature-Size" -- | This module provides support only for proof-of-possession (PoP) ciphersuite -- contexts: From fbb2199ad471cdc87862129e7b36ba6c3d1dd587 Mon Sep 17 00:00:00 2001 From: Thomas Vellekoop Date: Tue, 25 Aug 2026 16:21:36 +0200 Subject: [PATCH 3/5] cardano-crypto-class: factor BLS core sign/verify out by explicit context --- .../Cardano/Crypto/DSIGN/BLS12381/Internal.hs | 108 +++++++++++------- 1 file changed, 68 insertions(+), 40 deletions(-) diff --git a/cardano-crypto-class/src/Cardano/Crypto/DSIGN/BLS12381/Internal.hs b/cardano-crypto-class/src/Cardano/Crypto/DSIGN/BLS12381/Internal.hs index c63319dc6..bcb2327f2 100644 --- a/cardano-crypto-class/src/Cardano/Crypto/DSIGN/BLS12381/Internal.hs +++ b/cardano-crypto-class/src/Cardano/Crypto/DSIGN/BLS12381/Internal.hs @@ -295,6 +295,70 @@ type BLS12381CurveConstraints curve = , Typeable curve ) +-- The core signing routine shared by 'signDSIGN' and +-- 'createPossessionProofDSIGN'; the caller chooses the signing context (in +-- particular the DST, which differs between ordinary signatures and proofs of +-- possession). +{-# INLINE blsCoreSign #-} +blsCoreSign :: + forall curve a. + (BLS curve, BLS (DualCurve curve), SignableRepresentation a) => + BLS12381SignContext -> + a -> + SignKeyDSIGN (BLS12381DSIGN curve) -> + SigDSIGN (BLS12381DSIGN curve) +blsCoreSign BLS12381SignContext {blsSignContextDst = dst, blsSignContextAug = aug} msg (SignKeyBLS12381 (Scalar skPsb)) = + SigBLS12381 $ unsafeDupablePerformIO $ do + psbUseAsCPtr skPsb $ \skPtp -> do + withNewPoint_ @(DualCurve curve) $ \hashPtr -> do + withMaybeCStringLen dst $ \(dstPtr, dstLen) -> + withMaybeCStringLen aug $ \(augPtr, augLen) -> + unsafeUseAsCStringLen (getSignableRepresentation msg) $ \(msgPtr, msgLen) -> + c_blst_hash @(DualCurve curve) + hashPtr + msgPtr + (fromIntegral @Int @CSize msgLen) + dstPtr + (fromIntegral @Int @CSize dstLen) + augPtr + (fromIntegral @Int @CSize augLen) + withNewPoint' @(DualCurve curve) $ \sigPtr -> do + c_blst_sign @curve sigPtr hashPtr (ScalarPtr skPtp) + +-- The core verification routine shared by 'verifyDSIGN' and +-- 'verifyPossessionProofDSIGN'; as 'blsCoreSign', the caller chooses the +-- signing context. +{-# INLINE blsCoreVerify #-} +blsCoreVerify :: + forall curve a. + (BLS curve, BLS (DualCurve curve), SignableRepresentation a) => + BLS12381SignContext -> + VerKeyDSIGN (BLS12381DSIGN curve) -> + a -> + SigDSIGN (BLS12381DSIGN curve) -> + Either String () +blsCoreVerify BLS12381SignContext {blsSignContextDst = dst, blsSignContextAug = aug} (VerKeyBLS12381 pbPsb) msg (SigBLS12381 sigPsb) = + unsafeDupablePerformIO $ do + withMaybeCStringLen dst $ \(dstPtr, dstLen) -> do + withAffine (toAffine @curve pbPsb) $ \pkAff -> + withAffine (toAffine @(DualCurve curve) sigPsb) $ \sigAff -> + withMaybeCStringLen aug $ \(augPtr, augLen) -> + unsafeUseAsCStringLen (getSignableRepresentation msg) $ \(msgPtr, msgLen) -> do + err <- + c_blst_core_verify @curve + pkAff + sigAff + True + msgPtr + (fromIntegral @Int @CSize msgLen) + dstPtr + (fromIntegral @Int @CSize dstLen) + augPtr + (fromIntegral @Int @CSize augLen) + pure $! case mkBLSTError err of + BLST_SUCCESS -> Right () + _ -> Left "verifyDSIGN: BLS12381DSIGN signature failed to verify" + instance BLS12381CurveConstraints curve => DSIGNAlgorithm (BLS12381DSIGN curve) @@ -338,47 +402,11 @@ instance c_blst_sk_to_pk @curve vkPtp (ScalarPtr skp) {-# INLINE signDSIGN #-} - signDSIGN BLS12381SignContext {blsSignContextDst = dst, blsSignContextAug = aug} msg (SignKeyBLS12381 (Scalar skPsb)) = - SigBLS12381 $ unsafeDupablePerformIO $ do - psbUseAsCPtr skPsb $ \skPtp -> do - withNewPoint_ @(DualCurve curve) $ \hashPtr -> do - withMaybeCStringLen dst $ \(dstPtr, dstLen) -> - withMaybeCStringLen aug $ \(augPtr, augLen) -> - unsafeUseAsCStringLen (getSignableRepresentation msg) $ \(msgPtr, msgLen) -> - c_blst_hash @(DualCurve curve) - hashPtr - msgPtr - (fromIntegral @Int @CSize msgLen) - dstPtr - (fromIntegral @Int @CSize dstLen) - augPtr - (fromIntegral @Int @CSize augLen) - withNewPoint' @(DualCurve curve) $ \sigPtr -> do - c_blst_sign @curve sigPtr hashPtr (ScalarPtr skPtp) + signDSIGN = blsCoreSign {-# INLINE verifyDSIGN #-} -- Context can hold domain separation tag and/or augmentation data for signatures - verifyDSIGN BLS12381SignContext {blsSignContextDst = dst, blsSignContextAug = aug} (VerKeyBLS12381 pbPsb) msg (SigBLS12381 sigPsb) = - unsafeDupablePerformIO $ do - withMaybeCStringLen dst $ \(dstPtr, dstLen) -> do - withAffine (toAffine @curve pbPsb) $ \pkAff -> - withAffine (toAffine @(DualCurve curve) sigPsb) $ \sigAff -> - withMaybeCStringLen aug $ \(augPtr, augLen) -> - unsafeUseAsCStringLen (getSignableRepresentation msg) $ \(msgPtr, msgLen) -> do - err <- - c_blst_core_verify @curve - pkAff - sigAff - True - msgPtr - (fromIntegral @Int @CSize msgLen) - dstPtr - (fromIntegral @Int @CSize dstLen) - augPtr - (fromIntegral @Int @CSize augLen) - pure $! case mkBLSTError err of - BLST_SUCCESS -> Right () - _ -> Left "verifyDSIGN: BLS12381DSIGN signature failed to verify" + verifyDSIGN = blsCoreVerify {-# INLINE genKeyDSIGN #-} genKeyDSIGN = genKeyDSIGNWithContext Nothing @@ -574,13 +602,13 @@ instance {-# INLINE createPossessionProofDSIGN #-} createPossessionProofDSIGN sk = let vk = deriveVerKeyDSIGN sk :: VerKeyDSIGN (BLS12381DSIGN curve) - SigBLS12381 sig = signDSIGN (popProofSignContext (Proxy @curve)) (rawEncodeFixedSized vk) sk + SigBLS12381 sig = blsCoreSign (popProofSignContext (Proxy @curve)) (rawEncodeFixedSized vk) sk in PossessionProofBLS12381 sig {-# INLINE verifyPossessionProofDSIGN #-} verifyPossessionProofDSIGN vk (PossessionProofBLS12381 mu1Psb) = first (const "verifyPossessionProofDSIGN: BLS12381DSIGN failed to verify.") - (verifyDSIGN (popProofSignContext (Proxy @curve)) vk (rawEncodeFixedSized vk) (SigBLS12381 mu1Psb)) + (blsCoreVerify (popProofSignContext (Proxy @curve)) vk (rawEncodeFixedSized vk) (SigBLS12381 mu1Psb)) deriving stock instance BLS (DualCurve curve) => From 6820442ed7af2cbb9b8e0f38601c1b6b78225075 Mon Sep 17 00:00:00 2001 From: Thomas Vellekoop Date: Tue, 25 Aug 2026 16:35:50 +0200 Subject: [PATCH 4/5] cardano-crypto-class: fix BLS12-381 signing DST internally per curve variant --- cardano-crypto-class/CHANGELOG.md | 6 + .../bench/Bench/Crypto/DSIGN.hs | 5 +- .../src/Cardano/Crypto/DSIGN/BLS12381.hs | 4 +- .../Cardano/Crypto/DSIGN/BLS12381/Internal.hs | 209 +++++++++--------- .../testlib/Test/Crypto/DSIGN.hs | 17 +- 5 files changed, 113 insertions(+), 128 deletions(-) diff --git a/cardano-crypto-class/CHANGELOG.md b/cardano-crypto-class/CHANGELOG.md index 339b70b61..3d69b7cf1 100644 --- a/cardano-crypto-class/CHANGELOG.md +++ b/cardano-crypto-class/CHANGELOG.md @@ -10,6 +10,12 @@ (Section 4.2.3) instead of the `"BLS_SIG_"` one used for ordinary signatures. The PoP DST is selected internally per curve variant, so these functions (and `aggregateVerKeysDSIGN`) no longer take a signing context. +* Select the BLS12-381 *signing* DST internally per curve variant as well: + `ContextDSIGN (BLS12381DSIGN curve)` is now `()`, and `signDSIGN` / + `verifyDSIGN` use the canonical `"BLS_SIG_"`-prefixed DST of the PoP + ciphersuite for the chosen variant. `BLS12381SignContext`, `minSigPoPDST` and + `minVerKeyPoPDST` are removed from the public API, and message augmentation + is no longer supported (the POP scheme does not use it). ## 2.5.1.0 diff --git a/cardano-crypto-class/bench/Bench/Crypto/DSIGN.hs b/cardano-crypto-class/bench/Bench/Crypto/DSIGN.hs index 4ba3ddf6b..5110091bc 100644 --- a/cardano-crypto-class/bench/Bench/Crypto/DSIGN.hs +++ b/cardano-crypto-class/bench/Bench/Crypto/DSIGN.hs @@ -29,7 +29,7 @@ import Cardano.Crypto.Hash.Blake2b import Criterion import Bench.Crypto.BenchData -import Cardano.Crypto.DSIGN.BLS12381.Internal (BLS12381MinSigDSIGN, BLS12381MinVerKeyDSIGN, BLS12381DSIGN, BLS12381SignContext (..)) +import Cardano.Crypto.DSIGN.BLS12381.Internal (BLS12381MinSigDSIGN, BLS12381MinVerKeyDSIGN, BLS12381DSIGN) benchmarks :: Benchmark benchmarks = bgroup "DSIGN" @@ -114,9 +114,8 @@ instance ExampleContext SchnorrSecp256k1DSIGN where exampleContext _ = () #endif --- | This example context sets both the dst and augmentation to Nothing. instance ExampleContext (BLS12381DSIGN curve) where - exampleContext _ = BLS12381SignContext Nothing Nothing + exampleContext _ = () benchAggDSIGN :: forall v a . ( DSIGNAggregatable v diff --git a/cardano-crypto-class/src/Cardano/Crypto/DSIGN/BLS12381.hs b/cardano-crypto-class/src/Cardano/Crypto/DSIGN/BLS12381.hs index 26859a09e..633853508 100644 --- a/cardano-crypto-class/src/Cardano/Crypto/DSIGN/BLS12381.hs +++ b/cardano-crypto-class/src/Cardano/Crypto/DSIGN/BLS12381.hs @@ -1,8 +1,6 @@ module Cardano.Crypto.DSIGN.BLS12381 ( module X, - BLS12381SignContext, ) where -import Cardano.Crypto.DSIGN.BLS12381.Internal (BLS12381SignContext) -import Cardano.Crypto.DSIGN.BLS12381.Internal as X hiding (BLS12381SignContext) +import Cardano.Crypto.DSIGN.BLS12381.Internal as X diff --git a/cardano-crypto-class/src/Cardano/Crypto/DSIGN/BLS12381/Internal.hs b/cardano-crypto-class/src/Cardano/Crypto/DSIGN/BLS12381/Internal.hs index bcb2327f2..7d309bb3d 100644 --- a/cardano-crypto-class/src/Cardano/Crypto/DSIGN/BLS12381/Internal.hs +++ b/cardano-crypto-class/src/Cardano/Crypto/DSIGN/BLS12381/Internal.hs @@ -25,9 +25,6 @@ module Cardano.Crypto.DSIGN.BLS12381.Internal ( SignKeyDSIGN (..), SigDSIGN (..), PossessionProofDSIGN (..), - BLS12381SignContext (..), - minSigPoPDST, - minVerKeyPoPDST, ) where #include "blst_util.h" @@ -114,64 +111,13 @@ failDecodeBLS :: MonadFail m => String -> String -> m a failDecodeBLS ty msg = fail $ ty <> " BLS12381DSIGN: deserialisation failed (" <> msg <> ")" -data BLS12381DSIGN curve - --- Making sure different 'Signature schemes are not 'Coercible', which would ruin the --- intended type safety: -type role BLS12381DSIGN nominal - --- | The BLS12-381 minimal verification key size variant -type BLS12381MinVerKeyDSIGN = BLS12381DSIGN Curve1 - --- | The BLS12-381 minimal signature size variant -type BLS12381MinSigDSIGN = BLS12381DSIGN Curve2 - --- | The BLS12381 signing context for the "PoP" based ciphersuite for the minimal signature size variant of bls signatures -minSigPoPDST :: BLS12381SignContext -minSigPoPDST = BLS12381SignContext (Just "BLS_SIG_BLS12381G1_XMD:SHA-256_SSWU_RO_POP_") Nothing - --- | The BLS12381 signing context for the "PoP" based ciphersuite for the minimal verification key size variant of bls signatures -minVerKeyPoPDST :: BLS12381SignContext -minVerKeyPoPDST = BLS12381SignContext (Just "BLS_SIG_BLS12381G2_XMD:SHA-256_SSWU_RO_POP_") Nothing - --- The context used by @hash_pubkey_to_point@ when creating and verifying --- proofs of possession for the minimal signature size variant, as per --- draft-irtf-cfrg-bls-signature-06, Section 4.2.3: proofs of possession use --- @"BLS_POP_" || H2C_SUITE_ID || SC_TAG || "_"@ as DST, whereas ordinary --- signatures use the @"BLS_SIG_"@ prefix. Not exported: it is applied --- internally by 'createPossessionProofDSIGN' and 'verifyPossessionProofDSIGN', --- so users cannot accidentally create or verify a proof under the signature --- DST. -minSigPoPProofDST :: BLS12381SignContext -minSigPoPProofDST = BLS12381SignContext (Just "BLS_POP_BLS12381G1_XMD:SHA-256_SSWU_RO_POP_") Nothing - --- As 'minSigPoPProofDST', for the minimal verification key size variant. -minVerKeyPoPProofDST :: BLS12381SignContext -minVerKeyPoPProofDST = BLS12381SignContext (Just "BLS_POP_BLS12381G2_XMD:SHA-256_SSWU_RO_POP_") Nothing - --- Select the proof-of-possession context for the curve the verification keys --- live on. -popProofSignContext :: forall curve. Typeable curve => Proxy curve -> BLS12381SignContext -popProofSignContext _ = - case eqT @curve @Curve1 of - Just Refl -> minVerKeyPoPProofDST - Nothing -> minSigPoPProofDST - -type family CurveVariant (c :: Type) :: Symbol where - CurveVariant Curve1 = "BLS-Signature-Minimal-Verification-Key-Size" - CurveVariant Curve2 = "BLS-Signature-Minimal-Signature-Size" - --- | This module provides support only for proof-of-possession (PoP) ciphersuite --- contexts: --- --- * 'minSigPoPDST' --- * 'minVerKeyPoPDST' --- --- even though the underlying signing and verification primitives can be used --- to realise the Basic (@NUL@) and message-augmentation (@AUG@) schemes as --- well. +-- | A BLS12-381 signature scheme implementing the __proof of possession__ +-- (@POP@) ciphersuite of the IETF BLS signature draft +-- (draft-irtf-cfrg-bls-signature-06). The @curve@ type parameter selects one +-- of the two standard instantiations, 'BLS12381MinVerKeyDSIGN' or +-- 'BLS12381MinSigDSIGN'. -- --- == Why only the "PoP" ciphersuite is exported +-- == Why only the "PoP" ciphersuite is supported -- -- The main reason is API clarity and safety. -- @@ -197,34 +143,31 @@ type family CurveVariant (c :: Type) :: Symbol where -- -- By contrast, this module does /not/ provide the draft's general -- @AggregateVerify((PK_1, ..., PK_n), (message_1, ..., message_n), signature)@ --- API for aggregation over different messages. Exporting predefined Basic and --- AUG contexts would therefore suggest a broader aggregate-signature API than --- the module actually offers. +-- API for aggregation over different messages. Supporting the Basic and AUG +-- schemes would therefore suggest a broader aggregate-signature API than the +-- module actually offers. -- --- Restricting the public ciphersuite exports to PoP makes the intended usage --- explicit: this module supports ordinary BLS signing and verification, plus a --- PoP-based aggregation story. +-- == Curve variants and domain separation -- --- == What the exported contexts mean --- --- The exported values are standard BLS ciphersuite DSTs from +-- The two variants are standard BLS ciphersuite instantiations from -- draft-irtf-cfrg-bls-signature-06, Section 4.2: -- --- * 'minSigPoPDST' selects the __minimal-signature-size__ variant: +-- * 'BLS12381MinSigDSIGN' is the __minimal-signature-size__ variant: -- signatures live in G1 (48 bytes compressed), public keys in G2 -- (96 bytes compressed). -- --- * 'minVerKeyPoPDST' selects the __minimal-pubkey-size__ variant: +-- * 'BLS12381MinVerKeyDSIGN' is the __minimal-pubkey-size__ variant: -- public keys live in G1 (48 bytes compressed), signatures in G2 -- (96 bytes compressed). -- --- Within each variant, the PoP ciphersuite prescribes two DSTs (Section 4.2.3): --- ordinary signing and verification use the @\"BLS_SIG_\"@-prefixed DST --- ('minSigPoPDST' \/ 'minVerKeyPoPDST'), while creating and verifying proofs of --- possession hash the public key with the @\"BLS_POP_\"@-prefixed DST. --- 'createPossessionProofDSIGN' and 'verifyPossessionProofDSIGN' take no signing --- context: they select the @\"BLS_POP_\"@ context internally from the curve, so --- callers cannot accidentally use the signature DST for proofs of possession. +-- Within each variant, the PoP ciphersuite prescribes exactly one pair of +-- DSTs (Section 4.2.3): ordinary signing and verification use the +-- @\"BLS_SIG_\"@-prefixed DST, while creating and verifying proofs of +-- possession hash the public key with the @\"BLS_POP_\"@-prefixed DST. Both +-- DSTs are fixed internally from the curve variant, and the POP scheme does +-- not use message augmentation, so the signing context is trivial: +-- @'ContextDSIGN' ('BLS12381DSIGN' curve) = ()@. Users cannot sign, verify, +-- or prove possession under a non-canonical DST. -- -- The draft recommends the minimal-pubkey-size variant for aggregation, -- because the size of @(PK_1, ..., PK_n, signature)@ is usually dominated by @@ -241,8 +184,7 @@ type family CurveVariant (c :: Type) :: Symbol where -- >>> import Cardano.Crypto.Seed (mkSeedFromBytes) -- -- >>> :{ --- let ctx = minVerKeyPoPDST --- msg = BS.pack [0, 1, 2, 3] +-- let msg = BS.pack [0, 1, 2, 3] -- sk1 = -- genKeyDSIGNWithContext -- @BLS12381MinVerKeyDSIGN @@ -269,22 +211,72 @@ type family CurveVariant (c :: Type) :: Symbol where -- >>> Right avk = uncheckedAggregateVerKeysDSIGN [vk1, vk2] -- -- -- Both participants sign the same message --- >>> let sig1 = signDSIGN ctx msg sk1 --- >>> let sig2 = signDSIGN ctx msg sk2 +-- >>> let sig1 = signDSIGN () msg sk1 +-- >>> let sig2 = signDSIGN () msg sk2 -- -- The signatures can be aggregated: -- -- >>> Right asig = aggregateSigsDSIGN [sig1, sig2] -- -- -- The aggregate signature can then be checked against the aggregate key: --- >>> verifyDSIGN ctx avk msg asig +-- >>> verifyDSIGN () avk msg asig -- Right () -data BLS12381SignContext = BLS12381SignContext - { blsSignContextDst :: !(Maybe ByteString) - , blsSignContextAug :: !(Maybe ByteString) - } - deriving stock (Show, Eq, Generic) - deriving anyclass (NFData, NoThunks) +data BLS12381DSIGN curve + +-- Making sure different 'Signature schemes are not 'Coercible', which would ruin the +-- intended type safety: +type role BLS12381DSIGN nominal + +-- | The BLS12-381 minimal verification key size variant +type BLS12381MinVerKeyDSIGN = BLS12381DSIGN Curve1 + +-- | The BLS12-381 minimal signature size variant +type BLS12381MinSigDSIGN = BLS12381DSIGN Curve2 + +-- The DSTs of the "PoP" ciphersuite of the IETF BLS signature draft +-- (draft-irtf-cfrg-bls-signature-06, Section 4.2.3). Each curve variant has +-- exactly one canonical pair of DSTs: ordinary signing and verification use +-- the @"BLS_SIG_"@-prefixed DST, while creating and verifying proofs of +-- possession use the @"BLS_POP_"@-prefixed one (both are +-- @prefix || H2C_SUITE_ID || SC_TAG || "_"@). None of these are exported: +-- they are selected internally per curve variant via 'signatureDST' and +-- 'popProofDST', so users cannot sign, verify, or prove possession under a +-- non-canonical DST. + +-- Signing DST for the minimal signature size variant (signatures in G1). +minSigSignatureDST :: ByteString +minSigSignatureDST = "BLS_SIG_BLS12381G1_XMD:SHA-256_SSWU_RO_POP_" + +-- Signing DST for the minimal verification key size variant (signatures in G2). +minVerKeySignatureDST :: ByteString +minVerKeySignatureDST = "BLS_SIG_BLS12381G2_XMD:SHA-256_SSWU_RO_POP_" + +-- Proof-of-possession DST for the minimal signature size variant. +minSigPoPProofDST :: ByteString +minSigPoPProofDST = "BLS_POP_BLS12381G1_XMD:SHA-256_SSWU_RO_POP_" + +-- Proof-of-possession DST for the minimal verification key size variant. +minVerKeyPoPProofDST :: ByteString +minVerKeyPoPProofDST = "BLS_POP_BLS12381G2_XMD:SHA-256_SSWU_RO_POP_" + +-- Select the signing DST for the curve the verification keys live on. +signatureDST :: forall curve. Typeable curve => Proxy curve -> ByteString +signatureDST _ = + case eqT @curve @Curve1 of + Just Refl -> minVerKeySignatureDST + Nothing -> minSigSignatureDST + +-- Select the proof-of-possession DST for the curve the verification keys +-- live on. +popProofDST :: forall curve. Typeable curve => Proxy curve -> ByteString +popProofDST _ = + case eqT @curve @Curve1 of + Just Refl -> minVerKeyPoPProofDST + Nothing -> minSigPoPProofDST + +type family CurveVariant (c :: Type) :: Symbol where + CurveVariant Curve1 = "BLS-Signature-Minimal-Verification-Key-Size" + CurveVariant Curve2 = "BLS-Signature-Minimal-Signature-Size" type BLS12381CurveConstraints curve = ( BLS curve @@ -296,23 +288,23 @@ type BLS12381CurveConstraints curve = ) -- The core signing routine shared by 'signDSIGN' and --- 'createPossessionProofDSIGN'; the caller chooses the signing context (in --- particular the DST, which differs between ordinary signatures and proofs of --- possession). +-- 'createPossessionProofDSIGN'; the caller chooses the DST, which differs +-- between ordinary signatures and proofs of possession. The POP scheme does +-- not use message augmentation, so none is passed. {-# INLINE blsCoreSign #-} blsCoreSign :: forall curve a. (BLS curve, BLS (DualCurve curve), SignableRepresentation a) => - BLS12381SignContext -> + ByteString -> a -> SignKeyDSIGN (BLS12381DSIGN curve) -> SigDSIGN (BLS12381DSIGN curve) -blsCoreSign BLS12381SignContext {blsSignContextDst = dst, blsSignContextAug = aug} msg (SignKeyBLS12381 (Scalar skPsb)) = +blsCoreSign dst msg (SignKeyBLS12381 (Scalar skPsb)) = SigBLS12381 $ unsafeDupablePerformIO $ do psbUseAsCPtr skPsb $ \skPtp -> do withNewPoint_ @(DualCurve curve) $ \hashPtr -> do - withMaybeCStringLen dst $ \(dstPtr, dstLen) -> - withMaybeCStringLen aug $ \(augPtr, augLen) -> + unsafeUseAsCStringLen dst $ \(dstPtr, dstLen) -> + withMaybeCStringLen Nothing $ \(augPtr, augLen) -> unsafeUseAsCStringLen (getSignableRepresentation msg) $ \(msgPtr, msgLen) -> c_blst_hash @(DualCurve curve) hashPtr @@ -326,23 +318,22 @@ blsCoreSign BLS12381SignContext {blsSignContextDst = dst, blsSignContextAug = au c_blst_sign @curve sigPtr hashPtr (ScalarPtr skPtp) -- The core verification routine shared by 'verifyDSIGN' and --- 'verifyPossessionProofDSIGN'; as 'blsCoreSign', the caller chooses the --- signing context. +-- 'verifyPossessionProofDSIGN'; as 'blsCoreSign', the caller chooses the DST. {-# INLINE blsCoreVerify #-} blsCoreVerify :: forall curve a. (BLS curve, BLS (DualCurve curve), SignableRepresentation a) => - BLS12381SignContext -> + ByteString -> VerKeyDSIGN (BLS12381DSIGN curve) -> a -> SigDSIGN (BLS12381DSIGN curve) -> Either String () -blsCoreVerify BLS12381SignContext {blsSignContextDst = dst, blsSignContextAug = aug} (VerKeyBLS12381 pbPsb) msg (SigBLS12381 sigPsb) = +blsCoreVerify dst (VerKeyBLS12381 pbPsb) msg (SigBLS12381 sigPsb) = unsafeDupablePerformIO $ do - withMaybeCStringLen dst $ \(dstPtr, dstLen) -> do + unsafeUseAsCStringLen dst $ \(dstPtr, dstLen) -> do withAffine (toAffine @curve pbPsb) $ \pkAff -> withAffine (toAffine @(DualCurve curve) sigPsb) $ \sigAff -> - withMaybeCStringLen aug $ \(augPtr, augLen) -> + withMaybeCStringLen Nothing $ \(augPtr, augLen) -> unsafeUseAsCStringLen (getSignableRepresentation msg) $ \(msgPtr, msgLen) -> do err <- c_blst_core_verify @curve @@ -369,8 +360,9 @@ instance -- so these use the compressed sizes of the BLS12-381 `Point curve` type Signable (BLS12381DSIGN curve) = SignableRepresentation - -- Context can hold domain separation tag and/or augmentation data for signatures - type ContextDSIGN (BLS12381DSIGN curve) = BLS12381SignContext + -- The signing context carries no information: the DST is fixed internally + -- per curve variant, and the POP scheme does not use augmentation. + type ContextDSIGN (BLS12381DSIGN curve) = () type KeyGenContextDSIGN (BLS12381DSIGN curve) = Maybe ByteString newtype VerKeyDSIGN (BLS12381DSIGN curve) @@ -402,11 +394,10 @@ instance c_blst_sk_to_pk @curve vkPtp (ScalarPtr skp) {-# INLINE signDSIGN #-} - signDSIGN = blsCoreSign + signDSIGN () = blsCoreSign (signatureDST (Proxy @curve)) {-# INLINE verifyDSIGN #-} - -- Context can hold domain separation tag and/or augmentation data for signatures - verifyDSIGN = blsCoreVerify + verifyDSIGN () = blsCoreVerify (signatureDST (Proxy @curve)) {-# INLINE genKeyDSIGN #-} genKeyDSIGN = genKeyDSIGNWithContext Nothing @@ -602,13 +593,13 @@ instance {-# INLINE createPossessionProofDSIGN #-} createPossessionProofDSIGN sk = let vk = deriveVerKeyDSIGN sk :: VerKeyDSIGN (BLS12381DSIGN curve) - SigBLS12381 sig = blsCoreSign (popProofSignContext (Proxy @curve)) (rawEncodeFixedSized vk) sk + SigBLS12381 sig = blsCoreSign (popProofDST (Proxy @curve)) (rawEncodeFixedSized vk) sk in PossessionProofBLS12381 sig {-# INLINE verifyPossessionProofDSIGN #-} verifyPossessionProofDSIGN vk (PossessionProofBLS12381 mu1Psb) = first (const "verifyPossessionProofDSIGN: BLS12381DSIGN failed to verify.") - (blsCoreVerify (popProofSignContext (Proxy @curve)) vk (rawEncodeFixedSized vk) (SigBLS12381 mu1Psb)) + (blsCoreVerify (popProofDST (Proxy @curve)) vk (rawEncodeFixedSized vk) (SigBLS12381 mu1Psb)) deriving stock instance BLS (DualCurve curve) => diff --git a/cardano-crypto-class/testlib/Test/Crypto/DSIGN.hs b/cardano-crypto-class/testlib/Test/Crypto/DSIGN.hs index c168103f9..a04311742 100644 --- a/cardano-crypto-class/testlib/Test/Crypto/DSIGN.hs +++ b/cardano-crypto-class/testlib/Test/Crypto/DSIGN.hs @@ -68,9 +68,7 @@ import Cardano.Crypto.DSIGN ( BLS12381DSIGN, DSIGNAggregatable (..), - BLS12381SignContext, ) -import Cardano.Crypto.DSIGN.BLS12381.Internal (BLS12381SignContext (..)) import Cardano.Binary (FromCBOR, ToCBOR) import Cardano.Crypto.EllipticCurve.BLS12_381 (Curve1, Curve2, blsCompress, blsGenerator) import Cardano.Crypto.EllipticCurve.BLS12_381.Internal (blsZero) @@ -136,13 +134,6 @@ blsGenKeyWithContextGen = genNonEmptyBS = Gen.suchThat (BS.pack <$> arbitrary) (not . BS.null) -blsSignContextGen :: Gen BLS12381SignContext -blsSignContextGen = do - dst <- Gen.frequency [(1, pure Nothing), (100, Just . BS.pack <$> arbitrary)] - aug <- Gen.frequency [(1, pure Nothing), (100, Just . BS.pack <$> arbitrary)] - pure $ BLS12381SignContext dst aug - - #ifdef SECP256K1_ENABLED genEcdsaMsg :: Gen MessageHash genEcdsaMsg = @@ -196,8 +187,8 @@ tests lock = testDSIGNAlgorithm (Proxy @MockDSIGN) (arbitrary @Message) "MockDSIGN" testDSIGNAlgorithm (Proxy @Ed25519DSIGN) (arbitrary @Message) "Ed25519DSIGN" testDSIGNAlgorithm (Proxy @Ed448DSIGN) (arbitrary @Message) "Ed448DSIGN" - testDSIGNAlgorithmWithContext (Proxy @BLS12381MinVerKeyDSIGN) True blsSignContextGen blsGenKeyWithContextGen (arbitrary @Message) "BLS12381MinVerKeyDSIGN" - testDSIGNAlgorithmWithContext (Proxy @BLS12381MinSigDSIGN) True blsSignContextGen blsGenKeyWithContextGen (arbitrary @Message) "BLS12381MinSigDSIGN" + testDSIGNAlgorithmWithContext (Proxy @BLS12381MinVerKeyDSIGN) True (pure ()) blsGenKeyWithContextGen (arbitrary @Message) "BLS12381MinVerKeyDSIGN" + testDSIGNAlgorithmWithContext (Proxy @BLS12381MinSigDSIGN) True (pure ()) blsGenKeyWithContextGen (arbitrary @Message) "BLS12381MinSigDSIGN" #ifdef SECP256K1_ENABLED testDSIGNAlgorithm (Proxy @EcdsaSecp256k1DSIGN) genEcdsaMsg "EcdsaSecp256k1DSIGN" testDSIGNAlgorithm (Proxy @SchnorrSecp256k1DSIGN) (arbitrary @Message) "SchnorrSecp256k1DSIGN" @@ -211,8 +202,8 @@ tests lock = describe "MLocked" $ do testDSIGNMAlgorithm lock (Proxy @Ed25519DSIGN) "Ed25519DSIGN" describe "Aggregatable" $ do - testDSIGNAggregatableWithContext (Proxy @(BLS12381DSIGN Curve1)) blsSignContextGen blsGenKeyWithContextGen (arbitrary @Message) "BLS12381MinVerKeyDSIGN" - testDSIGNAggregatableWithContext (Proxy @(BLS12381DSIGN Curve2)) blsSignContextGen blsGenKeyWithContextGen (arbitrary @Message) "BLS12381MinSigDSIGN" + testDSIGNAggregatableWithContext (Proxy @(BLS12381DSIGN Curve1)) (pure ()) blsGenKeyWithContextGen (arbitrary @Message) "BLS12381MinVerKeyDSIGN" + testDSIGNAggregatableWithContext (Proxy @(BLS12381DSIGN Curve2)) (pure ()) blsGenKeyWithContextGen (arbitrary @Message) "BLS12381MinSigDSIGN" describe "PoP deserialisation rejects zero points" $ do -- DualCurve Curve1 = Curve2, so MinVerKeyDSIGN PoP points live on Curve2 -- DualCurve Curve2 = Curve1, so MinSigDSIGN PoP points live on Curve1 From 5180fe565b990b95a8e9df94aba7444a72b57bdf Mon Sep 17 00:00:00 2001 From: Thomas Vellekoop Date: Tue, 25 Aug 2026 16:42:17 +0200 Subject: [PATCH 5/5] cardano-crypto-leios: drop leiosSignContext, DST is internal to the scheme --- cardano-crypto-leios/CHANGELOG.md | 4 ++++ cardano-crypto-leios/src/Cardano/Crypto/Leios.hs | 14 ++++++-------- .../test/Test/Cardano/Crypto/Leios.hs | 5 ++--- .../testlib/Test/Cardano/Crypto/Leios/Gen.hs | 5 ++--- 4 files changed, 14 insertions(+), 14 deletions(-) diff --git a/cardano-crypto-leios/CHANGELOG.md b/cardano-crypto-leios/CHANGELOG.md index 60d40ee25..82da282c6 100644 --- a/cardano-crypto-leios/CHANGELOG.md +++ b/cardano-crypto-leios/CHANGELOG.md @@ -2,6 +2,10 @@ ## 0.2.0.0 +* Remove `leiosSignContext`: the CIP-164 DST is now fixed internally by + `BLS12381MinSigDSIGN`, so pass `()` as the signing context to `signDSIGN` / + `verifyDSIGN`. + * Remove: - `encodeLeiosCert` - `decodeLeiosCert` diff --git a/cardano-crypto-leios/src/Cardano/Crypto/Leios.hs b/cardano-crypto-leios/src/Cardano/Crypto/Leios.hs index 75c57d582..c5c47c203 100644 --- a/cardano-crypto-leios/src/Cardano/Crypto/Leios.hs +++ b/cardano-crypto-leios/src/Cardano/Crypto/Leios.hs @@ -20,7 +20,6 @@ module Cardano.Crypto.Leios ( LeiosSigningKey, LeiosVerificationKey, LeiosSignature, - leiosSignContext, leiosSignatureSize, leiosSignatureToBytes, @@ -59,7 +58,7 @@ import Cardano.Crypto.DSIGN ( VerKeyDSIGN, verifyDSIGN, ) -import Cardano.Crypto.DSIGN.BLS12381 (BLS12381MinSigDSIGN, BLS12381SignContext, minSigPoPDST) +import Cardano.Crypto.DSIGN.BLS12381 (BLS12381MinSigDSIGN) import Cardano.Crypto.Util (SignableRepresentation) import Control.DeepSeq (NFData) import Control.Monad (forM_, when) @@ -92,6 +91,10 @@ import GHC.Generics (Generic) import GHC.Stack (HasCallStack) import NoThunks.Class (NoThunks, OnlyCheckWhnfNamed (..)) +-- | The signature scheme used by Leios, per CIP-164: the BLS12-381 +-- minimal-signature-size proof-of-possession ciphersuite. The DSTs are fixed +-- internally by the scheme, so the signing context passed to 'signDSIGN' \/ +-- 'verifyDSIGN' is simply @()@. type LeiosDSIGN = BLS12381MinSigDSIGN type LeiosSigningKey = SignKeyDSIGN LeiosDSIGN @@ -100,11 +103,6 @@ type LeiosVerificationKey = VerKeyDSIGN LeiosDSIGN type LeiosSignature = SigDSIGN LeiosDSIGN --- | The BLS12-381 MinSig proof-of-possession ciphersuite DST used by Leios, --- per CIP-164. Pass this as the 'ContextDSIGN' to 'signDSIGN' / 'verifyDSIGN'. -leiosSignContext :: BLS12381SignContext -leiosSignContext = minSigPoPDST - -- | Size of a Leios signature in the chosen signature scheme. leiosSignatureSize :: Word leiosSignatureSize = fixedSize (Proxy @(SigDSIGN LeiosDSIGN)) @@ -333,7 +331,7 @@ verifyLeiosCert committee weightRequired msg cert = do aggVk <- uncheckedAggregateVerKeysDSIGN vks & first (const InvalidSignature) - verifyDSIGN leiosSignContext aggVk msg cert.leiosCertSignature + verifyDSIGN () aggVk msg cert.leiosCertSignature & first (const InvalidSignature) pure weightReceived where diff --git a/cardano-crypto-leios/test/Test/Cardano/Crypto/Leios.hs b/cardano-crypto-leios/test/Test/Cardano/Crypto/Leios.hs index e9a6db935..fbec759ba 100644 --- a/cardano-crypto-leios/test/Test/Cardano/Crypto/Leios.hs +++ b/cardano-crypto-leios/test/Test/Cardano/Crypto/Leios.hs @@ -24,7 +24,6 @@ import Cardano.Crypto.Leios ( Weight, aggregateLeiosCert, getLeiosVoterId, - leiosSignContext, resolveLeiosVoter, verifyLeiosCert, ) @@ -156,7 +155,7 @@ genMsg = chooseInt (0, 64) >>= genByteString signContribs :: BS.ByteString -> [(Int, LeiosSigningKey)] -> Map LeiosVoterId LeiosSignature signContribs msg pairs = Map.fromList - [(LeiosVoterId (fromIntegral @Int @Word16 i), signDSIGN leiosSignContext msg sk) | (i, sk) <- pairs] + [(LeiosVoterId (fromIntegral @Int @Word16 i), signDSIGN () msg sk) | (i, sk) <- pairs] -- | Aggregate or fail the property with the error. aggregateOrFail :: @@ -258,7 +257,7 @@ prop_aggregateLeiosCert_rejects_out_of_range = forAll genN $ \n -> let (sk0 :| _, committee) = fixedCommittee n msg = "x" :: BS.ByteString bad = LeiosVoterId (fromIntegral @Int @Word16 badIdx) - contributions = Map.singleton bad (signDSIGN leiosSignContext msg sk0) + contributions = Map.singleton bad (signDSIGN () msg sk0) in aggregateLeiosCert committee contributions === Left (VoterIdsOutOfBounds (bad :| [])) -- | Aggregating an empty contribution set must fail: the underlying BLS diff --git a/cardano-crypto-leios/testlib/Test/Cardano/Crypto/Leios/Gen.hs b/cardano-crypto-leios/testlib/Test/Cardano/Crypto/Leios/Gen.hs index f5aad0613..f909af4fb 100644 --- a/cardano-crypto-leios/testlib/Test/Cardano/Crypto/Leios/Gen.hs +++ b/cardano-crypto-leios/testlib/Test/Cardano/Crypto/Leios/Gen.hs @@ -31,7 +31,6 @@ import Cardano.Crypto.Leios ( LeiosVoter (..), LeiosVoterId (..), aggregateLeiosCert, - leiosSignContext, ) import Cardano.Crypto.Seed (mkSeedFromBytes) import qualified Data.Map.Strict as Map @@ -62,7 +61,7 @@ genLeiosSignature = do sk <- genLeiosSigningKey msgLen <- choose (0, 256) msg <- genByteString msgLen - pure $ signDSIGN leiosSignContext msg sk + pure $ signDSIGN () msg sk -- | Generate a real, canonical 'LeiosCert' by building a fresh committee -- and aggregating a non-empty subset of its members' signatures over a @@ -87,7 +86,7 @@ genLeiosCert = do msg <- genByteString msgLen let sigs = Map.fromList - [ (LeiosVoterId (fromIntegral @Int @Word16 i), signDSIGN leiosSignContext msg (sks !! i)) + [ (LeiosVoterId (fromIntegral @Int @Word16 i), signDSIGN () msg (sks !! i)) | i <- signerIxs ] case aggregateLeiosCert committee sigs of