From 4f63eeeb5671ddf833dae7ab6dae87ec51751db4 Mon Sep 17 00:00:00 2001 From: perturbing Date: Fri, 13 Feb 2026 10:29:45 +0100 Subject: [PATCH 1/4] remove `mu2` from PoP, following IETF draft --- .../Cardano/Crypto/DSIGN/BLS12381/Internal.hs | 53 +++++++------------ 1 file changed, 19 insertions(+), 34 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 0f10e20c1..46bb7c9f3 100644 --- a/cardano-crypto-class/src/Cardano/Crypto/DSIGN/BLS12381/Internal.hs +++ b/cardano-crypto-class/src/Cardano/Crypto/DSIGN/BLS12381/Internal.hs @@ -91,7 +91,6 @@ import Cardano.Crypto.EllipticCurve.BLS12_381.Internal ( blsMult, blsUncompress, c_blst_keygen, - compressedSizePoint, finalVerifyPairs, mkBLSTError, scalarFromBS, @@ -498,21 +497,16 @@ instance fromCBOR = decodeSigDSIGN instance - ( BLS12381CurveConstraints curve - , KnownNat (CompressedPointSize (DualCurve curve) + CompressedPointSize (DualCurve curve)) - ) => + BLS12381CurveConstraints curve => DSIGNAggregatable (BLS12381DSIGN curve) where type -- Sizes used in serialization/deserialization -- so these use the compressed sizes of the BLS12-381 `Point curve` PossessionProofSizeDSIGN (BLS12381DSIGN curve) = - CompressedPointSize (DualCurve curve) + CompressedPointSize (DualCurve curve) + CompressedPointSize (DualCurve curve) - data PossessionProofDSIGN (BLS12381DSIGN curve) = PossessionProofBLS12381 - { mu1 :: !(Point (DualCurve curve)) - , mu2 :: !(Point (DualCurve curve)) - } + newtype PossessionProofDSIGN (BLS12381DSIGN curve) = PossessionProofBLS12381 (Point (DualCurve curve)) deriving stock (Show, Generic) deriving anyclass (NoThunks) deriving anyclass (NFData) @@ -560,34 +554,25 @@ instance vk = blsCompress @curve vkPsb mu1Psb = blsMult (blsHash @(DualCurve curve) vk dst aug) skAsInteger - mu2Psb = - blsMult (blsGenerator @(DualCurve curve)) skAsInteger - return $ PossessionProofBLS12381 mu1Psb mu2Psb + return $ PossessionProofBLS12381 mu1Psb {-# INLINE verifyPossessionProofDSIGN #-} - verifyPossessionProofDSIGN BLS12381SignContext {blsSignContextDst = dst, blsSignContextAug = aug} (VerKeyBLS12381 vk) (PossessionProofBLS12381 mu1Psb mu2Psb) = - let check1 = - finalVerifyPairs @curve (blsGenerator, mu1Psb) (vk, blsHash (blsCompress vk) dst aug) - check2 = finalVerifyPairs @curve (vk, blsGenerator) (blsGenerator, mu2Psb) - in if check1 && check2 - then Right () - else Left "verifyPossessionProofDSIGN: BLS12381DSIGN failed to verify." + verifyPossessionProofDSIGN BLS12381SignContext {blsSignContextDst = dst, blsSignContextAug = aug} (VerKeyBLS12381 vk) (PossessionProofBLS12381 mu1Psb) = + if finalVerifyPairs @curve (blsGenerator, mu1Psb) (vk, blsHash (blsCompress vk) dst aug) + then Right () + else Left "verifyPossessionProofDSIGN: BLS12381DSIGN failed to verify." {-# INLINE rawSerialisePossessionProofDSIGN #-} - rawSerialisePossessionProofDSIGN (PossessionProofBLS12381 mu1Psb mu2Psb) = - blsCompress @(DualCurve curve) mu1Psb <> blsCompress @(DualCurve curve) mu2Psb + rawSerialisePossessionProofDSIGN (PossessionProofBLS12381 mu1Psb) = + blsCompress @(DualCurve curve) mu1Psb {-# INLINE rawDeserialisePossessionProofDSIGN #-} - rawDeserialisePossessionProofDSIGN bs = - let chunkSize = compressedSizePoint (Proxy @(DualCurve curve)) - (mu1Bs, mu2Bs) = BS.splitAt chunkSize bs - in do - -- Note that these also perform group membership and size checks. - -- It will also ensure that all of the supplied `ByteString` is consumed - -- through the size checks. - Right mu1Point <- pure $ blsUncompress @(DualCurve curve) mu1Bs - Right mu2Point <- pure $ blsUncompress @(DualCurve curve) mu2Bs - -- Reject the zero point (point at infinity) for both mu1 and mu2 - if blsIsInf @(DualCurve curve) mu1Point || blsIsInf @(DualCurve curve) mu2Point - then Nothing - else Just $ PossessionProofBLS12381 mu1Point mu2Point + rawDeserialisePossessionProofDSIGN bs = do + -- Note that these also perform group membership and size checks. + -- It will also ensure that all of the supplied `ByteString` is consumed + -- through the size checks. + Right mu1Point <- pure $ blsUncompress @(DualCurve curve) bs + -- Reject the zero point (point at infinity) for both mu1 and mu2 + if blsIsInf @(DualCurve curve) mu1Point + then Nothing + else Just $ PossessionProofBLS12381 mu1Point deriving stock instance BLS (DualCurve curve) => From 5aa1cf4a6f1ff784416f464a4d3253abbe7b01e3 Mon Sep 17 00:00:00 2001 From: perturbing Date: Fri, 13 Feb 2026 11:13:35 +0100 Subject: [PATCH 2/4] simplify `createPoP` with less FFI calls --- .../Cardano/Crypto/DSIGN/BLS12381/Internal.hs | 16 ++++------------ 1 file changed, 4 insertions(+), 12 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 46bb7c9f3..2430363b7 100644 --- a/cardano-crypto-class/src/Cardano/Crypto/DSIGN/BLS12381/Internal.hs +++ b/cardano-crypto-class/src/Cardano/Crypto/DSIGN/BLS12381/Internal.hs @@ -88,14 +88,12 @@ import Cardano.Crypto.EllipticCurve.BLS12_381.Internal ( blsGenerator, blsHash, blsIsInf, - blsMult, blsUncompress, c_blst_keygen, finalVerifyPairs, mkBLSTError, scalarFromBS, scalarToBS, - scalarToInteger, toAffine, withAffine, withMaybeCStringLen, @@ -545,16 +543,10 @@ instance else Right $ SigBLS12381 aggrPoint {-# INLINE createPossessionProofDSIGN #-} - createPossessionProofDSIGN BLS12381SignContext {blsSignContextDst = dst, blsSignContextAug = aug} (SignKeyBLS12381 skScalar) = - unsafeDupablePerformIO $ do - skAsInteger <- scalarToInteger skScalar - let VerKeyBLS12381 vkPsb = - deriveVerKeyDSIGN (SignKeyBLS12381 skScalar) :: - VerKeyDSIGN (BLS12381DSIGN curve) - vk = blsCompress @curve vkPsb - mu1Psb = - blsMult (blsHash @(DualCurve curve) vk dst aug) skAsInteger - return $ PossessionProofBLS12381 mu1Psb + createPossessionProofDSIGN ctx sk = + let vk = deriveVerKeyDSIGN sk :: VerKeyDSIGN (BLS12381DSIGN curve) + SigBLS12381 sig = signDSIGN ctx (rawSerialiseVerKeyDSIGN vk) sk + in PossessionProofBLS12381 sig {-# INLINE verifyPossessionProofDSIGN #-} verifyPossessionProofDSIGN BLS12381SignContext {blsSignContextDst = dst, blsSignContextAug = aug} (VerKeyBLS12381 vk) (PossessionProofBLS12381 mu1Psb) = if finalVerifyPairs @curve (blsGenerator, mu1Psb) (vk, blsHash (blsCompress vk) dst aug) From 49da3f2339edb92e8a0b431aba0ec643bc64a670 Mon Sep 17 00:00:00 2001 From: perturbing Date: Fri, 13 Feb 2026 11:52:16 +0100 Subject: [PATCH 3/4] simplify `verifyPoP` with less FFI calls --- .../src/Cardano/Crypto/DSIGN/BLS12381/Internal.hs | 12 +++++------- 1 file changed, 5 insertions(+), 7 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 2430363b7..faa8bcbb3 100644 --- a/cardano-crypto-class/src/Cardano/Crypto/DSIGN/BLS12381/Internal.hs +++ b/cardano-crypto-class/src/Cardano/Crypto/DSIGN/BLS12381/Internal.hs @@ -85,12 +85,9 @@ import Cardano.Crypto.EllipticCurve.BLS12_381.Internal ( ScalarPtr (..), blsAddOrDouble, blsCompress, - blsGenerator, - blsHash, blsIsInf, blsUncompress, c_blst_keygen, - finalVerifyPairs, mkBLSTError, scalarFromBS, scalarToBS, @@ -108,6 +105,7 @@ import Cardano.Crypto.PinnedSizedBytes ( import Cardano.Crypto.Seed (getBytesFromSeedT) import Cardano.Crypto.Util (SignableRepresentation (getSignableRepresentation)) import Control.DeepSeq (NFData) +import Data.Bifunctor (first) import Data.ByteString (ByteString) import qualified Data.ByteString as BS import Data.ByteString.Unsafe (unsafeUseAsCStringLen) @@ -548,10 +546,10 @@ instance SigBLS12381 sig = signDSIGN ctx (rawSerialiseVerKeyDSIGN vk) sk in PossessionProofBLS12381 sig {-# INLINE verifyPossessionProofDSIGN #-} - verifyPossessionProofDSIGN BLS12381SignContext {blsSignContextDst = dst, blsSignContextAug = aug} (VerKeyBLS12381 vk) (PossessionProofBLS12381 mu1Psb) = - if finalVerifyPairs @curve (blsGenerator, mu1Psb) (vk, blsHash (blsCompress vk) dst aug) - then Right () - else Left "verifyPossessionProofDSIGN: BLS12381DSIGN failed to verify." + verifyPossessionProofDSIGN ctx vk (PossessionProofBLS12381 mu1Psb) = + first + (const "verifyPossessionProofDSIGN: BLS12381DSIGN failed to verify.") + (verifyDSIGN ctx vk (rawSerialiseVerKeyDSIGN vk) (SigBLS12381 mu1Psb)) {-# INLINE rawSerialisePossessionProofDSIGN #-} rawSerialisePossessionProofDSIGN (PossessionProofBLS12381 mu1Psb) = blsCompress @(DualCurve curve) mu1Psb From 91032d98071740383b5303d420f683f29b030fa6 Mon Sep 17 00:00:00 2001 From: perturbing Date: Tue, 5 May 2026 11:47:22 +0200 Subject: [PATCH 4/4] add to changelog --- cardano-crypto-class/CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/cardano-crypto-class/CHANGELOG.md b/cardano-crypto-class/CHANGELOG.md index 4cef150d0..604afc4c2 100644 --- a/cardano-crypto-class/CHANGELOG.md +++ b/cardano-crypto-class/CHANGELOG.md @@ -2,6 +2,7 @@ ## 2.5.0.0 +* Drop mu2 from `PossessionProofDSIGN` * Add `Ord` superclass constraint for the `CertVRF` associated type in `VRFAlgorithm` * Add `Ord` instances for `CertVRF {SimpleVRF,PraosVRF,PraosBatchCompatVRF}` * Add `Ord` instances for `Cardano.Crypto.VRF.Praos{,BatchCompat}.Proof`