diff --git a/src/ZkFold/Base/Algebra/EllipticCurve/Pasta.hs b/src/ZkFold/Base/Algebra/EllipticCurve/Pasta.hs new file mode 100644 index 000000000..98bf57db8 --- /dev/null +++ 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 index 4f5aefcdd..b84e290aa 100644 --- 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 index 09286861c..851b617f7 100644 --- 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 index 6a7a64e7f..a4818f5f4 100644 --- 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 index 20dcb4870..7af061417 100644 --- 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