Merge pull request #258 from zkFold/pasta-curve

Add Pasta curve
zkFold · Sep 16, 2024 · e2ca837 · e2ca837
2 parents d1e18fa + 21bccff
commit e2ca837
Show file tree

Hide file tree

Showing 5 changed files with 108 additions and 0 deletions.
diff --git a/src/ZkFold/Base/Algebra/EllipticCurve/Pasta.hs b/src/ZkFold/Base/Algebra/EllipticCurve/Pasta.hs
@@ -0,0 +1,96 @@
+{-# LANGUAGE DerivingVia #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+module ZkFold.Base.Algebra.EllipticCurve.Pasta where
+
+import           Prelude
+
+import           ZkFold.Base.Algebra.Basic.Class
+import           ZkFold.Base.Algebra.Basic.Field
+import           ZkFold.Base.Algebra.Basic.Number
+import           ZkFold.Base.Algebra.EllipticCurve.Class
+import           ZkFold.Base.Data.ByteString
+
+-------------------------------- Introducing Fields ----------------------------------
+
+type FpModulus = 0x40000000000000000000000000000000224698fc094cf91b992d30ed00000001
+instance Prime FpModulus
+
+type FqModulus = 0x40000000000000000000000000000000224698fc0994a8dd8c46eb2100000001
+instance Prime FqModulus
+
+type Fp = Zp FpModulus
+type Fq = Zp FqModulus
+
+------------------------------------ Pallas ------------------------------------
+
+data Pallas
+
+instance EllipticCurve Pallas where
+    type ScalarField Pallas = Fq
+
+    type BaseField Pallas = Fp
+
+    inf = Inf
+
+    gen = Point
+        0x40000000000000000000000000000000224698fc094cf91b992d30ed00000000
+        0x02
+
+    add = addPoints
+
+    mul = pointMul
+
+instance StandardEllipticCurve Pallas where
+    aParameter = zero
+
+    bParameter = fromConstant (5 :: Natural)
+
+------------------------------------ Vesta ------------------------------------
+
+data Vesta
+
+instance EllipticCurve Vesta where
+
+    type ScalarField Vesta = Fp
+
+    type BaseField Vesta = Fq
+
+    inf = Inf
+
+    gen = Point
+        0x40000000000000000000000000000000224698fc0994a8dd8c46eb2100000000
+        0x02
+
+    add = addPoints
+
+    mul = pointMul
+
+instance StandardEllipticCurve Vesta where
+    aParameter = zero
+
+    bParameter = fromConstant (5 :: Natural)
+
+------------------------------------ Encoding ------------------------------------
+
+instance Binary (Point Pallas) where
+  put Inf           = put (Point @Pallas zero zero)
+  put (Point xp yp) = put xp >> put yp
+  get = do
+    xp <- get
+    yp <- get
+    return $
+      if xp == zero && yp == zero
+      then Inf
+      else Point xp yp
+
+instance Binary (Point Vesta) where
+  put Inf           = put (Point @Vesta zero zero)
+  put (Point xp yp) = put xp >> put yp
+  get = do
+    xp <- get
+    yp <- get
+    return $
+      if xp == zero && yp == zero
+      then Inf
+      else Point xp yp
diff --git a/tests/Tests/Binary.hs b/tests/Tests/Binary.hs
@@ -10,6 +10,7 @@ import           ZkFold.Base.Algebra.Basic.Field             (Zp)
 import           ZkFold.Base.Algebra.EllipticCurve.BLS12_381 (BLS12_381_G1, BLS12_381_G2, BLS12_381_Scalar)
 import           ZkFold.Base.Algebra.EllipticCurve.BN254     (BN254_G1, BN254_G2)
 import           ZkFold.Base.Algebra.EllipticCurve.Class     (Point, PointCompressed)
+import           ZkFold.Base.Algebra.EllipticCurve.Pasta     (Pallas, Vesta)
 import           ZkFold.Base.Data.ByteString                 (LittleEndian, fromByteString, toByteString)
 
 doesRoundtrip :: (Binary a, Eq a, Show a) => a -> Property
@@ -28,3 +29,5 @@ specBinary = hspec $ describe "Binary instance" $ do
   prop "roundtrips PointCompressed BLS12_381_G1" $ doesRoundtrip @(PointCompressed BLS12_381_G1)
   prop "roundtrips Point BLS12_381_G2"           $ doesRoundtrip @(Point BLS12_381_G2)
   prop "roundtrips PointCompressed BLS12_381_G2" $ doesRoundtrip @(PointCompressed BLS12_381_G2)
+  prop "roundtrips Point Pallas"                 $ doesRoundtrip @(Point Pallas)
+  prop "roundtrips Point Vesta"                  $ doesRoundtrip @(Point Vesta)
diff --git a/tests/Tests/Field.hs b/tests/Tests/Field.hs
@@ -14,6 +14,7 @@ import           Test.QuickCheck
 import           ZkFold.Base.Algebra.Basic.Class
 import qualified ZkFold.Base.Algebra.EllipticCurve.BLS12_381 as BLS12_381
 import qualified ZkFold.Base.Algebra.EllipticCurve.BN254     as BN254
+import qualified ZkFold.Base.Algebra.EllipticCurve.Pasta     as Pasta
 
 specField' :: forall a . (Field a, Eq a, Show a, Arbitrary a, Typeable a) => IO ()
 specField' = hspec $ do
@@ -52,3 +53,6 @@ specField = do
     specField' @BLS12_381.Fq2
     specField' @BLS12_381.Fq6
     specField' @BLS12_381.Fq12
+
+    specField' @Pasta.Fp
+    specField' @Pasta.Fq
diff --git a/tests/Tests/Group.hs b/tests/Tests/Group.hs
@@ -15,6 +15,7 @@ import           ZkFold.Base.Algebra.Basic.Class
 import           ZkFold.Base.Algebra.EllipticCurve.BLS12_381
 import           ZkFold.Base.Algebra.EllipticCurve.BN254
 import           ZkFold.Base.Algebra.EllipticCurve.Class
+import           ZkFold.Base.Algebra.EllipticCurve.Pasta     (Pallas, Vesta)
 
 specAdditiveGroup' :: forall a . (AdditiveGroup a, Eq a, Show a, Arbitrary a, Typeable a) => IO ()
 specAdditiveGroup' = hspec $ do
@@ -37,3 +38,6 @@ specAdditiveGroup = do
 
     specAdditiveGroup' @(Point BLS12_381_G1)
     specAdditiveGroup' @(Point BLS12_381_G2)
+
+    specAdditiveGroup' @(Point Pallas)
+    specAdditiveGroup' @(Point Vesta)
diff --git a/zkfold-base.cabal b/zkfold-base.cabal
@@ -97,6 +97,7 @@ library
       ZkFold.Base.Algebra.Basic.VectorSpace
       ZkFold.Base.Algebra.EllipticCurve.BLS12_381
       ZkFold.Base.Algebra.EllipticCurve.BN254
+      ZkFold.Base.Algebra.EllipticCurve.Pasta
       ZkFold.Base.Algebra.EllipticCurve.Class
       ZkFold.Base.Algebra.EllipticCurve.Ed25519
       ZkFold.Base.Algebra.EllipticCurve.Pairing