Add BLS signature scheme to DSIGN interface

cardano-crypto-class/CHANGELOG.md

@@ -2,6 +2,9 @@
 
 ## 2.2.4.0
 
+* Add `BLS12-381` aggregatable signature schemes
+* Extend `DSIGNAlgorithm v` to also support optional `genKeyDSIGNWithKeyInfo`
+* Introduce `DSIGNAggregatable v` class that extends `DSIGNAlgorithm v`
 * Add Cabal components using code moved from `cardano-crypto-tests`:
   - `lib:testlib`
   - `lib:benchlib`

cardano-crypto-class/README.md

@@ -4,6 +4,8 @@ This package defines type classes and mock instances for the following cryptogra
 
   - A digital signature scheme
 
+  - An aggregatable signature scheme
+
   - A cryptographic hashing function
 
   - A key-evolving signature scheme

cardano-crypto-class/bench/Bench/Crypto/DSIGN.hs

@@ -1,11 +1,10 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
 
 {- FOURMOLU_DISABLE -}
 
@@ -15,6 +14,7 @@ module Bench.Crypto.DSIGN
 
 import Data.Proxy
 import Data.ByteString (ByteString)
+import qualified Data.Foldable as F
 
 import Control.DeepSeq
 
@@ -29,11 +29,15 @@ import Cardano.Crypto.Hash.Blake2b
 import Criterion
 
 import Bench.Crypto.BenchData
-
+import Cardano.Crypto.DSIGN.BLS12381 (BLS12381MinSigDSIGN, BLS12381MinVerKeyDSIGN, BLS12381DSIGN, BLS12381SignContext (..))
 
 benchmarks :: Benchmark
 benchmarks = bgroup "DSIGN"
   [ benchDSIGN (Proxy :: Proxy Ed25519DSIGN) "Ed25519"
+  , benchDSIGN (Proxy :: Proxy BLS12381MinVerKeyDSIGN) "BLS12381MinVerKey"
+  , benchDSIGN (Proxy :: Proxy BLS12381MinSigDSIGN) "BLS12381MinSig"
+  , benchAggDSIGN (Proxy :: Proxy BLS12381MinVerKeyDSIGN) "BLS12381MinVerKey"
+  , benchAggDSIGN (Proxy :: Proxy BLS12381MinSigDSIGN) "BLS12381MinSig"
 #ifdef SECP256K1_ENABLED
   , benchDSIGN (Proxy :: Proxy EcdsaSecp256k1DSIGN) "EcdsaSecp256k1"
   , benchDSIGN (Proxy :: Proxy SchnorrSecp256k1DSIGN) "SchnorrSecp256k1"
@@ -42,9 +46,9 @@ benchmarks = bgroup "DSIGN"
 
 benchDSIGN :: forall v a
            . ( DSIGNAlgorithm v
-             , ContextDSIGN v ~ ()
              , Signable v a
              , ExampleSignable v a
+             , ExampleContext v
              , NFData (SignKeyDSIGN v)
              , NFData (VerKeyDSIGN v)
              , NFData (SigDSIGN v)
@@ -53,21 +57,24 @@ benchDSIGN :: forall v a
           -> String
           -> Benchmark
 benchDSIGN _ lbl =
+  let msg = exampleSignable (Proxy @v)
+      ctx = exampleContext (Proxy @v)
+  in
   bgroup lbl
     [ bench "genKeyDSIGN" $
         nf (genKeyDSIGN @v) testSeed
 
     , env (return (genKeyDSIGN @v testSeed)) $ \signKey ->
       bench "signDSIGN" $
-        nf (signDSIGN @v () (exampleSignable (Proxy @v))) signKey
+        nf (signDSIGN @v ctx msg) signKey
 
     , env (let signKey = genKeyDSIGN @v testSeed
                verKey  = deriveVerKeyDSIGN signKey
-               sig     = signDSIGN @v () (exampleSignable (Proxy @v)) signKey
+               sig     = signDSIGN @v ctx msg signKey
             in return (verKey, sig)
           ) $ \ ~(verKey, sig) ->
       bench "verifyDSIGN" $
-        nf (verifyDSIGN @v () verKey (exampleSignable (Proxy @v))) sig
+        nf (verifyDSIGN @v ctx verKey msg) sig
     ]
 
 -- | A helper class to gloss over the differences in the 'Signable' constraint
@@ -79,10 +86,115 @@ class ExampleSignable v a | v -> a where
 instance ExampleSignable Ed25519DSIGN ByteString where
   exampleSignable _ = typicalMsg
 
+instance ExampleSignable (BLS12381DSIGN curve) ByteString where
+  exampleSignable _ = typicalMsg
+
 #ifdef SECP256K1_ENABLED
 instance ExampleSignable EcdsaSecp256k1DSIGN MessageHash where
   exampleSignable _ = hashAndPack (Proxy @Blake2b_256) typicalMsg
 
 instance ExampleSignable SchnorrSecp256k1DSIGN ByteString where
   exampleSignable _ = typicalMsg
 #endif
+
+-- | Provide an example context for each DSIGN algorithm.
+-- similar to 'ExampleSignable', this glosses over differences in the
+-- 'ContextDSIGN' associated type.
+class ExampleContext v where
+  exampleContext :: Proxy v -> ContextDSIGN v
+
+instance ExampleContext Ed25519DSIGN where
+  exampleContext _ = ()
+
+#ifdef SECP256K1_ENABLED
+instance ExampleContext EcdsaSecp256k1DSIGN where
+  exampleContext _ = ()
+
+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
+
+benchAggDSIGN :: forall v a
+  . ( DSIGNAggregatable v
+    , Signable v a
+    , ExampleSignable v a
+    , ExampleContext v
+    , NFData (SignKeyDSIGN v)
+    , NFData (VerKeyDSIGN v)
+    , NFData (SigDSIGN v)
+    , NFData (PossessionProofDSIGN v)
+    )
+  => Proxy v
+  -> String
+  -> Benchmark
+benchAggDSIGN _ lbl =
+  let msg = exampleSignable (Proxy @v)
+      ctx = exampleContext (Proxy @v)
+      ns = 1 : [100, 200 .. 1000]
+  in bgroup (lbl <> "/Aggregatable") $
+      [ bgroup ("n=" <> show n)
+          [ env (pure (mkCase @v ctx msg n)) $ \c ->
+              bench "provePoP (all)" $
+                nf (proveAllPoPs @v ctx) (caseSKs c)
+
+          , env (pure (mkCase @v ctx msg n)) $ \c ->
+              bench "verifyPoP (all)" $
+                nf (verifyAllPoPs @v ctx) (caseVKPoPs c)
+
+          , env (pure (mkCase @v ctx msg n)) $ \c ->
+              bench "aggregateVerKeys (with PoPs)" $
+                nf (aggregateVerKeysDSIGN @v ctx) (caseVKPoPs c)
+
+          , env (pure (mkCase @v ctx msg n)) $ \c ->
+              bench "aggregateVerKeys (no PoPs)" $
+                nf (uncheckedAggregateVerKeysDSIGN @v) (caseVKs c)
+
+          , env (pure (mkCase @v ctx msg n)) $ \c ->
+              bench "aggregateSig" $
+                nf (aggregateSigsDSIGN @v) (caseSigs c)
+          ]
+      | n <- ns
+      ]
+
+data AggCase v = AggCase
+  { caseSKs    :: ![SignKeyDSIGN v]
+  , caseVKs    :: ![VerKeyDSIGN v]
+  , caseVKPoPs :: ![(VerKeyDSIGN v, PossessionProofDSIGN v)]
+  , caseSigs   :: ![SigDSIGN v]
+  }
+
+instance
+  ( NFData (SignKeyDSIGN v)
+  , NFData (VerKeyDSIGN v)
+  , NFData (PossessionProofDSIGN v)
+  , NFData (SigDSIGN v)
+  ) => NFData (AggCase v) where
+  rnf (AggCase sks vks vkp sigs) =
+    rnf sks `seq`
+    rnf vks `seq`
+    rnf vkp `seq`
+    rnf sigs
+
+mkCase :: forall v a. (DSIGNAggregatable v, Signable v a)
+  => ContextDSIGN v -> a -> Int -> AggCase v
+mkCase ctx msg n =
+  let sks  = replicate n (genKeyDSIGN @v testSeed)
+      vks  = map deriveVerKeyDSIGN sks
+      pops = map (createPossessionProofDSIGN @v ctx) 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)
+
+verifyAllPoPs :: forall v. DSIGNAggregatable v
+  => ContextDSIGN v
+  -> [(VerKeyDSIGN v, PossessionProofDSIGN v)]
+  -> Either String ()
+verifyAllPoPs ctx = F.foldl' (\acc (vk,pop) -> acc >> verifyPossessionProofDSIGN @v ctx vk pop) (Right ())

cardano-crypto-class/cardano-crypto-class.cabal

@@ -58,6 +58,7 @@ library
   hs-source-dirs: src
   exposed-modules:
     Cardano.Crypto.DSIGN
+    Cardano.Crypto.DSIGN.BLS12381
     Cardano.Crypto.DSIGN.Class
     Cardano.Crypto.DSIGN.Ed25519
     Cardano.Crypto.DSIGN.Ed448

cardano-crypto-class/src/Cardano/Crypto/DSIGN.hs

@@ -6,6 +6,7 @@ module Cardano.Crypto.DSIGN (
 )
 where
 
+import Cardano.Crypto.DSIGN.BLS12381 as X
 import Cardano.Crypto.DSIGN.Class as X
 import Cardano.Crypto.DSIGN.Ed25519 as X
 import Cardano.Crypto.DSIGN.Ed448 as X