Group elements generator

symbolic-base/group-elements-generator/Main.hs

@@ -0,0 +1,97 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+
+module Main (main) where
+
+import           Data.Aeson                             (ToJSON, encode)
+import qualified Data.ByteString.Lazy.Char8             as BL
+import           Data.List                              (find, intercalate)
+import           Data.Maybe                             (fromJust)
+import           Data.Typeable                          (Proxy (..), Typeable, typeRep)
+import           Numeric.Natural                        (Natural)
+import           Options.Applicative
+import           Prelude
+
+import           ZkFold.Algebra.Class                   (FromConstant (..), Scale (..))
+import           ZkFold.Algebra.EllipticCurve.BLS12_381 (BLS12_381_G1_Point, BLS12_381_G2_Point)
+import           ZkFold.Algebra.EllipticCurve.BN254     (BN254_G1_Point, BN254_G2_Point)
+import           ZkFold.Algebra.EllipticCurve.Class     (CyclicGroup (..))
+
+data Group = forall pt. (CyclicGroup pt, Show pt, ToJSON pt, Typeable pt) => Group
+
+supportedGroups :: [(String, Group)]
+supportedGroups =
+    [ ("bn254-g1", Group @BN254_G1_Point)
+    , ("bn254-g2", Group @BN254_G2_Point)
+    , ("bls12381-g1", Group @BLS12_381_G1_Point)
+    , ("bls12381-g2", Group @BLS12_381_G2_Point)
+    ]
+
+groupName :: Group -> String
+groupName (Group @pt) = fst $ fromJust $ find f supportedGroups
+  where
+    f (_, g) = case g of
+      Group @pt' -> typeRep (Proxy @pt) == typeRep (Proxy @pt')
+
+-- | Output format
+data OutputFormat = Plain | JSON
+    deriving (Eq, Show)
+
+-- | Parse group from string
+parseGroup :: String -> Maybe Group
+parseGroup s = lookup s supportedGroups
+
+-- | CLI options
+data Options = Options
+  { optGroup  :: Group
+  , optSeed   :: Natural
+  , optLength :: Natural
+  , optFormat :: OutputFormat
+  }
+
+optionsParser :: Parser Options
+optionsParser =
+  let groupList = map fst supportedGroups
+      groupListStr = intercalate " | " groupList
+      groupHelp = "Group name: one of { " <> groupListStr <> " }"
+  in Options
+    <$> option (maybeReader parseGroup)
+          (long "group" <> short 'g' <> metavar "GROUP" <> help groupHelp)
+    <*> option auto
+          (long "seed" <> short 's' <> metavar "SEED" <> help "Exponent seed (natural number)")
+    <*> option auto
+          (long "length" <> short 'l' <> metavar "LENGTH" <> help "Number of elements to generate")
+    <*> flag Plain JSON
+          (long "json" <> help "Output as JSON array of points")
+
+runGroupElementsGeneric :: forall pt.
+  ( Scale (ScalarFieldOf pt) pt
+  , FromConstant Natural (ScalarFieldOf pt)
+  , Show pt
+  , ToJSON pt
+  )
+  => Options -> pt -> IO ()
+runGroupElementsGeneric opts g =
+  let x = optSeed opts
+      n = optLength opts
+      fmt = optFormat opts
+      group = optGroup opts
+      exps = [x ^ k | k <- [0..n-1]]
+      points = [scale (fromConstant @_ @(ScalarFieldOf pt) e) g | e <- exps]
+  in case fmt of
+    Plain -> do
+      putStrLn $ "Generated group points (" <> groupName group <> ") :"
+      mapM_ print points
+    JSON -> do
+      let fname = groupName group <> "_n" <> show n <> ".json"
+      BL.writeFile fname (encode points)
+      putStrLn $ "Wrote JSON to " <> fname
+
+main :: IO ()
+main = do
+  opts <- execParser $ info (optionsParser <**> helper)
+    ( fullDesc
+   <> progDesc "Generate group elements by multiplying the generator point by powers of a seed (from 0 to LENGTH-1)."
+   <> header "Group Elements Generator"
+    )
+  case optGroup opts of
+    Group @pt -> runGroupElementsGeneric opts (pointGen :: pt)

symbolic-base/hie.yaml

@@ -14,3 +14,6 @@ cradle:
 
     - path: "bench/BenchLagrangeBasis.hs"
       component: "symbolic-base:bench:bench-lagrange-basis"
+
+    - path: "app/GroupElementsGenerator.hs"
+      component: "symbolic-base:exe:group-elements-generator"

symbolic-base/src/ZkFold/Algebra/Field.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE AllowAmbiguousTypes  #-}
+{-# LANGUAGE DeriveAnyClass       #-}
 {-# LANGUAGE DerivingStrategies   #-}
 {-# LANGUAGE OverloadedLists      #-}
 {-# LANGUAGE TypeApplications     #-}
@@ -17,7 +18,7 @@ module ZkFold.Algebra.Field (
 
 import           Control.Applicative                  (liftA2, pure, (<*>), (<|>))
 import           Control.DeepSeq                      (NFData (..))
-import           Data.Aeson                           (FromJSON (..), FromJSONKey (..), ToJSON (..), ToJSONKey (..))
+import           Data.Aeson                           (FromJSON (..), FromJSONKey, ToJSON (..), ToJSONKey)
 import           Data.Bool                            (Bool)
 import qualified Data.Bool                            as Bool
 import           Data.Function                        (const, id, ($), (.))
@@ -48,7 +49,8 @@ import           ZkFold.Prelude                       (iterate', log2ceiling)
 ------------------------------ Prime Fields -----------------------------------
 
 newtype Zp (p :: Natural) = Zp Integer
-    deriving (Generic, NFData, ToJSONKey, FromJSONKey)
+    deriving Generic
+    deriving newtype (NFData, ToJSONKey, FromJSONKey)
 
 {-# INLINE fromZp #-}
 fromZp :: Zp p -> Natural
@@ -232,7 +234,7 @@ class (Ring poly, UnivariateFieldPolynomial f poly) => IrreduciblePoly poly f (e
     irreduciblePoly :: poly
 
 data Ext2 f (e :: Symbol) = Ext2 f f
-    deriving (Haskell.Eq, Haskell.Show, Generic)
+    deriving (Haskell.Eq, Haskell.Show, Generic, ToJSON, FromJSON)
 
 instance Haskell.Ord f => Haskell.Ord (Ext2 f e) where
     Ext2 a b <= Ext2 c d = [b, a] Haskell.<= ([d, c] :: [f])
@@ -301,7 +303,7 @@ instance (Field f, Eq f, IrreduciblePoly poly f e, Arbitrary f) => Arbitrary (Ex
     arbitrary = Ext2 <$> arbitrary <*> arbitrary
 
 data Ext3 f (e :: Symbol) = Ext3 f f f
-    deriving (Haskell.Eq, Haskell.Show, Generic)
+    deriving (Haskell.Eq, Haskell.Show, Generic, ToJSON, FromJSON)
 
 instance Haskell.Ord f => Haskell.Ord (Ext3 f e) where
     Ext3 a b c <= Ext3 d e f = [c, b, a] Haskell.<= ([f, e, d] :: [f])

symbolic-base/src/ZkFold/Protocol/Plonk.hs

@@ -41,7 +41,7 @@ data Plonk i o (n :: Natural) g1 g2 transcript pv = Plonk {
         k2    :: ScalarFieldOf g1,
         ac    :: ArithmeticCircuit (ScalarFieldOf g1) i o,
         h1    :: g2,
-        gs'   :: Vector (n + 5) g1
+        gs'   :: Vector (n + 6) g1
     }
 
 fromPlonkup ::

symbolic-base/src/ZkFold/Protocol/Plonkup/Internal.hs

@@ -33,7 +33,7 @@ data Plonkup i o (n :: Natural) g1 g2 transcript pv = Plonkup {
         k2    :: ScalarFieldOf g1,
         ac    :: ArithmeticCircuit (ScalarFieldOf g1) i o,
         h1    :: g2,
-        gs'   :: Vector (n + 5) g1
+        gs'   :: Vector (n + 6) g1
     }
 
 type PlonkupPermutationSize n = 3 * n
@@ -52,7 +52,7 @@ instance (Show (ScalarFieldOf g1), Show1 o, Show g1, Show g2) => Show (Plonkup i
 
 instance
   ( KnownNat n
-  , KnownNat (n + 5)
+  , KnownNat (n + 6)
   , Arbitrary g1
   , Arbitrary g2
   , Arithmetic (ScalarFieldOf g1)

symbolic-base/src/ZkFold/Protocol/Plonkup/Utils.hs

@@ -5,6 +5,7 @@
 module ZkFold.Protocol.Plonkup.Utils where
 
 import           Data.Bool                          (bool)
+import           Data.Functor.Rep                   (tabulate)
 import           Data.List                          (sortOn)
 import qualified Data.Map                           as M
 import qualified Data.Set                           as S
@@ -14,7 +15,7 @@ import           Prelude                            hiding (Num (..), drop, leng
 import           ZkFold.Algebra.Class
 import           ZkFold.Algebra.EllipticCurve.Class (CyclicGroup (..))
 import           ZkFold.Algebra.Number
-import           ZkFold.Data.Vector                 (Vector, unsafeToVector)
+import           ZkFold.Data.Vector                 (Vector)
 import           ZkFold.Prelude                     (iterateN', log2ceiling)
 import           ZkFold.Symbolic.Class              (Arithmetic)
 
@@ -42,14 +43,14 @@ getParams n = findK' 0
                 && S.disjoint hGroupK1 hGroupK2
 
 getSecretParams :: forall n g1 g2 .
-    ( KnownNat n
+    ( KnownNat (n + 6)
     , Arithmetic (ScalarFieldOf g1)
     , CyclicGroup g1
     , CyclicGroup g2
     , Scale (ScalarFieldOf g1) g2
-    ) => ScalarFieldOf g1 -> (Vector (n + 5) g1, g2)
+    ) => ScalarFieldOf g1 -> (Vector (n + 6) g1, g2)
 getSecretParams x =
-    let xs = unsafeToVector $ fmap (x^) [0 .. (value @n + 5)]
+    let xs = tabulate (\e -> x ^ toConstant e)
         gs = fmap (`scale` pointGen) xs
         h1 = x `scale` pointGen
     in (gs, h1)

symbolic-base/symbolic-base.cabal

@@ -437,3 +437,15 @@ benchmark bench-lagrange-basis
       symbolic-base,
       tasty-bench,
       QuickCheck
+
+executable group-elements-generator
+    import: options-exe
+    main-is: Main.hs
+    hs-source-dirs: group-elements-generator
+    build-depends:
+      base,
+      aeson,
+      bytestring,
+      optparse-applicative,
+      symbolic-base,
+

symbolic-examples/src/ZkFold/Symbolic/Examples/UtxoAccumulator.hs

@@ -1,14 +1,16 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE DeriveAnyClass      #-}
 {-# LANGUAGE TypeOperators       #-}
 
 module ZkFold.Symbolic.Examples.UtxoAccumulator where
 
+import           Data.Aeson                                 (FromJSON, ToJSON)
 import           Data.ByteString                            (ByteString)
 import           Data.Function                              (const, flip, ($))
 import           Data.Functor                               (fmap)
 import           Data.Functor.Rep                           (tabulate)
-import           Data.List                                  ((++))
-import           GHC.Generics                               (Par1 (..), U1 (..), (:*:) (..), (:.:) (..))
+import           GHC.Generics                               (Generic, Par1 (..), U1 (..), (:*:) (..), (:.:) (..))
+import           Prelude                                    ((++))
 
 import           ZkFold.Algebra.Class                       (fromConstant, one, toConstant, zero, (+), (-!))
 import           ZkFold.Algebra.EllipticCurve.BLS12_381     (BLS12_381_G1_Point, BLS12_381_G2_Point)
@@ -18,22 +20,22 @@ import           ZkFold.Algebra.Polynomial.Univariate       (PolyVec)
 import           ZkFold.Data.ByteString                     (Binary)
 import           ZkFold.Data.HFunctor                       (hmap)
 import           ZkFold.Data.Vector                         (Vector, unsafeToVector)
-import           ZkFold.Prelude                             (length, replicate, (!!))
+import           ZkFold.Prelude                             (length, replicate, take, (!!))
 import           ZkFold.Protocol.NonInteractiveProof        (NonInteractiveProof (setupProve, setupVerify), prove)
 import           ZkFold.Protocol.Plonkup                    (Plonkup (..), PlonkupPolyExtendedLength)
 import           ZkFold.Protocol.Plonkup.Input              (PlonkupInput)
 import           ZkFold.Protocol.Plonkup.Internal           (lagrangeBasisGroupElements)
 import           ZkFold.Protocol.Plonkup.Proof              (PlonkupProof)
 import           ZkFold.Protocol.Plonkup.Prover             (PlonkupProverSecret (..), PlonkupProverSetup (..))
 import           ZkFold.Protocol.Plonkup.Update             (updateProverSetup, updateVerifierSetup)
-import           ZkFold.Protocol.Plonkup.Utils              (getParams, getSecretParams)
+import           ZkFold.Protocol.Plonkup.Utils              (getParams)
 import           ZkFold.Protocol.Plonkup.Verifier           (PlonkupVerifierSetup)
 import           ZkFold.Protocol.Plonkup.Witness            (PlonkupWitnessInput (..))
 import           ZkFold.Symbolic.Algorithm.Hash.MiMC        (hash)
 import           ZkFold.Symbolic.Class                      (Arithmetic, Symbolic)
 import           ZkFold.Symbolic.Compiler                   (compileWith)
 import           ZkFold.Symbolic.Compiler.ArithmeticCircuit (ArithmeticCircuit, solder)
-import           ZkFold.Symbolic.Data.Bool                  (Bool (..), BoolType (..), all, any)
+import           ZkFold.Symbolic.Data.Bool                  (Bool (..), all, any, (&&))
 import           ZkFold.Symbolic.Data.Eq                    (Eq (..))
 import           ZkFold.Symbolic.Data.FieldElement          (FieldElement (..))
 import           ZkFold.Symbolic.Interpreter                (Interpreter)
@@ -72,29 +74,42 @@ utxoAccumulatorInput :: forall n a .
 utxoAccumulatorInput hs as (a, r) =
     hs :*: as :*: (Par1 a :*: Par1 r)
 
+data UtxoAccumulatorCRS = UtxoAccumulatorCRS
+    { crsGs        :: [BLS12_381_G1_Point]
+    , crsHs        :: [BLS12_381_G2_Point]
+    , crsAccElems  :: [BLS12_381_G1_Point]
+    , crsDistElems :: [BLS12_381_G1_Point]
+    }
+    deriving (Generic, FromJSON, ToJSON)
+
 type UtxoAccumulatorProtocol n m = Plonkup (UtxoAccumulatorInput n) (UtxoAccumulatorOutput n) m BLS12_381_G1_Point BLS12_381_G2_Point ByteString (PolyVec (ScalarFieldOf BLS12_381_G1_Point))
 
-utxoAccumulatorProtocol :: forall n m . (KnownNat n, KnownNat m) => UtxoAccumulatorProtocol n m
-utxoAccumulatorProtocol =
+utxoAccumulatorProtocol :: forall n m . (KnownNat n, KnownNat m)
+    => UtxoAccumulatorCRS
+    -> UtxoAccumulatorProtocol n m
+utxoAccumulatorProtocol crs =
     let
         (omega, k1, k2) = getParams (value @m)
-        (gs, h1) = getSecretParams $ fromConstant @(ScalarFieldOf BLS12_381_G1_Point) 42
+        gs = unsafeToVector $ take (value @m + 6) (crsGs crs)
+        h1 = crsHs crs !! 1
     in
         Plonkup omega k1 k2 utxoAccumulatorCircuit h1 gs
 
 utxoAccumulatorProverSetup :: forall n m . (KnownNat n, KnownNat m, KnownNat (PlonkupPolyExtendedLength m))
-    => [ScalarFieldOf BLS12_381_G1_Point]
+    => UtxoAccumulatorCRS
+    -> [ScalarFieldOf BLS12_381_G1_Point]
     -> [ScalarFieldOf BLS12_381_G1_Point]
     -> PlonkupProverSetup (UtxoAccumulatorInput n) (UtxoAccumulatorOutput n) m BLS12_381_G1_Point BLS12_381_G2_Point (PolyVec (ScalarFieldOf BLS12_381_G1_Point))
-utxoAccumulatorProverSetup hs as =
+utxoAccumulatorProverSetup crs hs as =
     flip updateProverSetup (as ++ replicate (value @n -! length hs) zero) $
     flip updateProverSetup (hs ++ replicate (value @n -! length hs) zero) $
     flip updateProverSetup [one] $
-    setupProve utxoAccumulatorProtocol
+    setupProve $ utxoAccumulatorProtocol crs
 
 utxoAccumulatorProverSetupInit :: forall n m . (KnownNat n, KnownNat m, KnownNat (PlonkupPolyExtendedLength m))
-    => PlonkupProverSetup (UtxoAccumulatorInput n) (UtxoAccumulatorOutput n) m BLS12_381_G1_Point BLS12_381_G2_Point (PolyVec (ScalarFieldOf BLS12_381_G1_Point))
-utxoAccumulatorProverSetupInit = utxoAccumulatorProverSetup [] []
+    => UtxoAccumulatorCRS
+    -> PlonkupProverSetup (UtxoAccumulatorInput n) (UtxoAccumulatorOutput n) m BLS12_381_G1_Point BLS12_381_G2_Point (PolyVec (ScalarFieldOf BLS12_381_G1_Point))
+utxoAccumulatorProverSetupInit crs = utxoAccumulatorProverSetup crs [] []
 
 utxoAccumulatorHash ::
        ScalarFieldOf BLS12_381_G1_Point
@@ -107,40 +122,47 @@ utxoAccumulatorHash a r =
         toConstant $ hash (f a, f r)
 
 utxoAccumulatorProve :: forall n m . (KnownNat n, KnownNat m, KnownNat (PlonkupPolyExtendedLength m))
-    => [ScalarFieldOf BLS12_381_G1_Point]
+    => UtxoAccumulatorCRS
+    -> [ScalarFieldOf BLS12_381_G1_Point]
     -> [ScalarFieldOf BLS12_381_G1_Point]
     -> ScalarFieldOf BLS12_381_G1_Point
     -> ScalarFieldOf BLS12_381_G1_Point
     -> (PlonkupInput BLS12_381_G1_Point, PlonkupProof BLS12_381_G1_Point)
-utxoAccumulatorProve hs as a r =
+utxoAccumulatorProve crs hs as a r =
     let
-        setup = utxoAccumulatorProverSetup hs as
+        setup = utxoAccumulatorProverSetup crs hs as
         witness = PlonkupWitnessInput (unsafeToVector hs :*: unsafeToVector as :*: Par1 a :*: Par1 r)
         secret = PlonkupProverSecret $ tabulate (\k -> utxoAccumulatorHash r $ fromConstant $ toConstant k)
     in
         prove @(UtxoAccumulatorProtocol n m) setup (witness, secret)
 
 utxoAccumulatorVerifierSetup :: forall n m . (KnownNat n, KnownNat m, KnownNat (PlonkupPolyExtendedLength m))
-    => PlonkupVerifierSetup (UtxoAccumulatorInput n) (UtxoAccumulatorOutput n) m BLS12_381_G1_Point BLS12_381_G2_Point (PolyVec (ScalarFieldOf BLS12_381_G1_Point))
-utxoAccumulatorVerifierSetup = updateVerifierSetup (setupVerify utxoAccumulatorProtocol) [one] [validationGroupElement @n @m]
+    => UtxoAccumulatorCRS
+    -> PlonkupVerifierSetup (UtxoAccumulatorInput n) (UtxoAccumulatorOutput n) m BLS12_381_G1_Point BLS12_381_G2_Point (PolyVec (ScalarFieldOf BLS12_381_G1_Point))
+utxoAccumulatorVerifierSetup crs =
+    updateVerifierSetup (setupVerify $ utxoAccumulatorProtocol crs) [one] [validationGroupElement @n @m crs]
 
 utxoAccumulatorGroupElements :: forall n m . (KnownNat n, KnownNat m, KnownNat (PlonkupPolyExtendedLength m))
-    => [BLS12_381_G1_Point]
-utxoAccumulatorGroupElements =
+    => UtxoAccumulatorCRS
+    -> [BLS12_381_G1_Point]
+utxoAccumulatorGroupElements crs =
     let
-        PlonkupProverSetup {..} = utxoAccumulatorProverSetupInit @n @m
+        PlonkupProverSetup {..} = utxoAccumulatorProverSetupInit @n @m crs
     in
         lagrangeBasisGroupElements @m @BLS12_381_G1_Point @(PolyVec (ScalarFieldOf BLS12_381_G1_Point)) omega gs
 
 validationGroupElement :: forall n m . (KnownNat n, KnownNat m, KnownNat (PlonkupPolyExtendedLength m))
-    => BLS12_381_G1_Point
-validationGroupElement = utxoAccumulatorGroupElements @n @m !! 0
+    => UtxoAccumulatorCRS
+    -> BLS12_381_G1_Point
+validationGroupElement crs = utxoAccumulatorGroupElements @n @m crs !! 0
 
 accumulationGroupElements :: forall n m . (KnownNat n, KnownNat m, KnownNat (PlonkupPolyExtendedLength m))
-    => Vector n BLS12_381_G1_Point
-accumulationGroupElements = tabulate (\(toConstant -> i) ->
-    utxoAccumulatorGroupElements @n @m !! (i + 1))
+    => UtxoAccumulatorCRS
+    -> Vector n BLS12_381_G1_Point
+accumulationGroupElements crs = tabulate (\(toConstant -> i) ->
+    utxoAccumulatorGroupElements @n @m crs !! (i + 1))
 
 distributionGroupElements :: forall n m . (KnownNat n, KnownNat m, KnownNat (PlonkupPolyExtendedLength m))
-    => Vector n BLS12_381_G1_Point
-distributionGroupElements = tabulate (\(toConstant -> i) -> utxoAccumulatorGroupElements @n @m !! (value @n + i + 1))
+    => UtxoAccumulatorCRS
+    -> Vector n BLS12_381_G1_Point
+distributionGroupElements crs = tabulate (\(toConstant -> i) -> utxoAccumulatorGroupElements @n @m crs !! (value @n + i + 1))