pasta-curves (empty) → 0.0.0.0
raw patch · 13 files changed
+1171/−0 lines, 13 filesdep +basedep +bytestringdep +criterion
Dependencies added: base, bytestring, criterion, cryptonite, memory, tasty, tasty-hunit, tasty-quickcheck, utf8-string
Files
- CHANGELOG.md +11/−0
- LICENSE +21/−0
- README.md +48/−0
- app/Main.hs +31/−0
- benchmark/Main.hs +80/−0
- pasta-curves.cabal +77/−0
- src/Crypto/ECC/Curves.hs +223/−0
- src/Crypto/ECC/Fields.hs +251/−0
- src/Crypto/ECC/Pasta.hs +147/−0
- src/Crypto/ECC/PastaCurves.hs +80/−0
- test/Spec.hs +17/−0
- test/TestCurves.hs +122/−0
- test/TestFields.hs +63/−0
+ CHANGELOG.md view
@@ -0,0 +1,11 @@+# Changelog++`pasta-curves` uses [PVP Versioning][1].+The changelog is available [on GitHub][2].++## 0.0.0.0++* Initially created.++[1]: https://pvp.haskell.org+[2]: https://github.com/nccgroup/pasta-curves/releases
+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2022 Eric Schorn++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.md view
@@ -0,0 +1,48 @@+# pasta-curves++[](https://github.com/nccgroup/pasta-curves/actions/workflows/stack.yml)+[](https://github.com/nccgroup/pasta-curves/actions/workflows/cabal.yml)+[](https://hackage.haskell.org/package/pasta-curves)+[](http://stackage.org/lts/package/pasta-curves)+[](http://stackage.org/nightly/package/pasta-curves)+[](LICENSE)+++This Haskell library provides the Pasta Curves consisting of: the `Pallas`+curve and its `Fp` field element, the `Vesta` curve and its `Fq` field +element, and a variety of supporting functionality such as point/element +arithmetic, serialization, and hash-to-curve. The algorithms are NOT constant+time.++Pallas is y<sup>2</sup> = x<sup>3</sup> + 5 over F<sub>p</sub>(0x40000000000000000000000000000000224698fc094cf91b992d30ed00000001).+The order of the Pallas curve is 0x40000000000000000000000000000000224698fc0994a8dd8c46eb2100000001.+++Vesta is y<sup>2</sup> = x<sup>3</sup> + 5 over F<sub>q</sub>(0x40000000000000000000000000000000224698fc0994a8dd8c46eb2100000001).+The order of the Vesta curve is 0x40000000000000000000000000000000224698fc094cf91b992d30ed00000001.++The curves are designed such that the order of one matches the field +characteristic of the other. For a brief introduction, see the Zcash blog +titled ["The Pasta Curves for Halo 2 and Beyond"](https://electriccoin.co/blog/the-pasta-curves-for-halo-2-and-beyond/).+The reference Rust implementation (which inspired this implementation) +can be found at: <https://github.com/zcash/pasta_curves>.++Example usage of this library implementation:++~~~+$ cabal repl++ghci> a = 9 :: Fp++ghci> a*a+0x0000000000000000000000000000000000000000000000000000000000000051++ghci> pointMul a base :: Vesta+Projective {_px = 0x3CDC6A090F2BB3B52714C083929B620FE24ADBCBBD420752108CD7C29E543E5E, + _py = 0x08795CD330B3CE5AA63BD2B18DE155AE3C96E8AF9DA2CC742C6BA1464E490161, + _pz = 0x1FA26F58F3A641ADFE81775D3D53378D6178B6CCBF14F9BD4AB5F10DEE28D878}+~~~++---++Copyright 2022 Eric Schorn; Licensed under the MIT License.
+ app/Main.hs view
@@ -0,0 +1,31 @@+{-|+Module : app.Main (internal)+Description : Trivial target for application executable build.+Copyright : (c) Eric Schorn, 2022+Maintainer : eric.schorn@nccgroup.com+Stability : experimental+Portability : GHC+SPDX-License-Identifier: MIT++This module provides a trivial Main target for application executable builds.+-}++{-# LANGUAGE NoImplicitPrelude, Safe #-}++module Main (main) where++import Prelude+import PastaCurves++main :: IO ()+main = do+ print "Sample executable for pasta-curves"+ print $ pointMul (2 ^ (200::Integer) - 1 :: Fq) (base :: Pallas)+ -- print exampleFp+ -- print exampleFq+ -- print examplePallasPt+ -- print exampleVestaPt++{- For profiling+ cabal v2-run --enable-profiling exes -- +RTS -p+-}
+ benchmark/Main.hs view
@@ -0,0 +1,80 @@+{-|+Module : benchmark.Main (internal)+Description : Target for benchmarking build.+Copyright : (c) Eric Schorn, 2022+Maintainer : eric.schorn@nccgroup.com+Stability : experimental+Portability : GHC+SPDX-License-Identifier: MIT++This module provides a basic Main target for benchmarking builds. The suite of+benchmarks will be expanded over time.+-}++{-# LANGUAGE NoImplicitPrelude, Safe #-}++module Main (main) where++import Prelude+import Data.ByteString.UTF8 (fromString)+import Criterion.Main+import PastaCurves+import Criterion.Types (timeLimit, resamples)+++benchConfig = defaultConfig {+ timeLimit = 60,+ resamples = 20+ }++-- Benchmarks will be further developed in future versions...+main :: IO ()+main = defaultMainWith benchConfig [+ bgroup "Group 1" [ + bench "Hello Pallas 1" $ whnf hashToPallas (fromString "Hello Pallas 1"), + bench "Hello Pallas 2" $ whnf hashToPallas (fromString "Hello Pallas 2"), + bench "Hello Vesta 1" $ whnf hashToVesta (fromString "Hello Vesta 1"), + bench "Hello Vesta 2" $ whnf hashToVesta (fromString "Hello Vesta 2"), + bench "Pasta base * -1" $ whnf (pointMul (-1 :: Fq)) (base :: Pallas),+ bench "Pasta base * 2^200 - 1" $ whnf (pointMul (2 ^ (200::Integer) - 1 :: Fq)) (base :: Pallas),+ bench "Pasta base * 2^100 - 1" $ whnf (pointMul (2 ^ (100::Integer) - 1 :: Fq)) (base :: Pallas),+ bench "Vesta base * -1" $ whnf (pointMul (-1 :: Fp)) (base :: Vesta)+ ]+ ]++-- Note: Initial field multiply performance is in line with expected Rust BigInt described at+-- https://research.nccgroup.com/2021/09/10/optimizing-pairing-based-cryptography-montgomery-multiplication-in-assembly/++{- Potential performance improvements to investigate/implement+0. Inline (<- almost zero) and other compiler directives (-O2 <- almost zero)+1. Remove field add/sub MOD by compare then subtract (<- almost zero)+2. Remove field mul MOD by Barrett reduction / Montgomery multiplication+3. Implement explicit pointDouble routine+4. Separate out statics (e.g. in sqrt routines)++Base Case+=========+benchmarking Group 1/Hello Pallas 1+time 2.213 ms (2.190 ms .. 2.257 ms)++benchmarking Group 1/Hello Pallas 2+time 2.437 ms (2.428 ms .. 2.441 ms)++benchmarking Group 1/Hello Vesta 1+time 2.458 ms (2.454 ms .. 2.464 ms)++benchmarking Group 1/Hello Vesta 2+time 2.378 ms (2.371 ms .. 2.398 ms)++benchmarking Group 1/Pasta base * -1+time 92.48 μs (92.35 μs .. 92.73 μs)++benchmarking Group 1/Pasta base * 2^200 - 1+time 106.4 μs (104.4 μs .. 109.1 μs)++benchmarking Group 1/Pasta base * 2^100 - 1+time 31.51 μs (31.45 μs .. 31.58 μs)++benchmarking Group 1/Vesta base * -1+time 92.43 μs (91.97 μs .. 92.79 μs)+-}
+ pasta-curves.cabal view
@@ -0,0 +1,77 @@+cabal-version: 3.0+name: pasta-curves+version: 0.0.0.0+synopsis: Provides the Pasta curves: Pallas, Vesta and their field elements Fp and Fq.+description: Provides the Pasta curves: Pallas, Vesta and their field elements Fp and Fq. + See the PastaCurves module below and/or the GitHub repository README.md for more details.+homepage: https://github.com/nccgroup/pasta-curves+bug-reports: https://github.com/nccgroup/pasta-curves/issues+license: MIT+license-file: LICENSE+author: Eric Schorn+maintainer: Eric Schorn <eric.schorn@nccgroup.com>+copyright: 2022 Eric Schorn+category: Cryptography, Elliptic Curves+build-type: Simple+extra-doc-files: README.md+ CHANGELOG.md+tested-with: GHC == 8.6.5+ || == 8.8.4+ || == 8.10.7+ || == 9.0.2+ || == 9.2.2++source-repository head+ type: git+ location: https://github.com/nccgroup/pasta-curves.git++common common-options+ build-depends: base >= 4.12 && < 4.17,+ utf8-string >= 1 && < 1.0.3,+ cryptonite >= 0.29 && < 0.31,+ memory >= 0.16 && < 0.18,+ bytestring >= 0.10 && < 0.11.4+ other-modules: Curves, Fields, Pasta+ ghc-options: -Weverything+ -Wno-missing-import-lists+ -Wno-unsafe+ -Wno-all-missed-specialisations+ default-language: Haskell2010++library+ import: common-options+ hs-source-dirs: src/Crypto/ECC+ exposed-modules: PastaCurves++executable pasta-curves+ import: common-options+ hs-source-dirs: app, src/Crypto/ECC+ main-is: Main.hs+ other-modules: PastaCurves+ ghc-options: -threaded+ -rtsopts+ -with-rtsopts=-N++test-suite pasta-curves-test+ import: common-options+ type: exitcode-stdio-1.0+ hs-source-dirs: test, src/Crypto/ECC+ main-is: Spec.hs+ other-modules: PastaCurves, TestFields, TestCurves+ build-depends: tasty >= 1.4 && < 1.5,+ tasty-hunit >= 0.10 && < 0.11,+ tasty-quickcheck >= 0.10 && < 0.11+ ghc-options: -threaded+ -rtsopts+ -with-rtsopts=-N++benchmark pasta-curves-benchmark+ import: common-options+ type: exitcode-stdio-1.0+ hs-source-dirs: benchmark, src/Crypto/ECC+ main-is: Main.hs+ other-modules: PastaCurves+ build-depends: criterion >= 1.5 && < 1.6+ ghc-options: -threaded+ -rtsopts+ -with-rtsopts=-N
+ src/Crypto/ECC/Curves.hs view
@@ -0,0 +1,223 @@+{-|+Module : Crypto.PastaCurves.Curves (internal)+Description : Supports the instantiation of parameterized prime-order elliptic curves.+Copyright : (c) Eric Schorn, 2022+Maintainer : eric.schorn@nccgroup.com+Stability : experimental+Portability : GHC+SPDX-License-Identifier: MIT++This internal module provides an elliptic curve (multi-use) template from arbitrary+parameters for a curve of odd order, along with a variety of supporting functionality +such as point addition, multiplication, negation, equality, serialization and +deserialization. The algorithms are NOT constant time. Safety and simplicity are the +top priorities; the curve order must be prime (and so affine curve point y-cord != 0).+-}++{-# LANGUAGE CPP, DataKinds, DerivingStrategies, FlexibleInstances, PolyKinds #-}+{-# LANGUAGE MultiParamTypeClasses, NoImplicitPrelude, Safe, ScopedTypeVariables #-}++module Curves (Curve(..), CurvePt(..), Point(..)) where++import Prelude hiding (drop, length, sqrt)+import Control.Monad (mfilter)+import Data.ByteString (ByteString, cons, drop, index, length, pack)+import Data.Maybe (fromJust)+import Data.Typeable (Proxy (Proxy))+import GHC.TypeLits (Nat, KnownNat, natVal)+import Fields (Field (..))+++-- | The `Point` type incorporates type literals @a@ and @b@ of an elliptic curve in the+-- short Weierstrass normal form. It also incorporates @baseX@ and @baseY@ coordinates+-- for the base type. A point with different literals is considered a different type, so+-- cannot be inadvertently mixed. *The curve order must be prime, and `_y` cannot be zero*.+data Point (a :: Nat) (b :: Nat) (baseX :: Nat) (baseY :: Nat) f = + Projective {_x :: f, _y :: f, _z :: f} deriving stock (Show) -- (x * inv0 z, y * inv0 z)+ ++-- CPP macro 'helpers' to extract the curve parameters from `Point a b baseX baseY f`+#define A natVal (Proxy :: Proxy a)+#define B natVal (Proxy :: Proxy b)+#define BASE_X natVal (Proxy :: Proxy baseX)+#define BASE_Y natVal (Proxy :: Proxy baseY)+++-- Calculate equality for projective points+instance (Field f, KnownNat a, KnownNat b, KnownNat baseX, KnownNat baseY) =>+ Eq (Point a b baseX baseY f) where+ + -- x1/z1 == x2/z2 -> x1*z2/(x2*z1) == 1 -> same for y -> x1*z2/(x2*z1) == y1*z2/(y2*z1)+ -- All (neutral) points at infinity are equal. + (==) (Projective x1 y1 z1) (Projective x2 y2 z2) = + (x1 * z2 == x2 * z1) && (y1 * z2 == y2 * z1)+++-- | The `CurvePt` class provides the bulk of the functionality related to operations+-- involving points on the elliptic curve. It supports both the Pallas and Vesta curve+-- point types, as well as any other curves (using the arbitrary curve parameters). The+-- curve order must be prime.+class CurvePt a where++ -- | Returns the (constant) base point.+ base :: a+ + -- | The `fromBytesC` function deserializes a compressed point from a ByteString. An + -- invalid ByteString will return @Nothing@.+ fromBytesC :: ByteString -> Maybe a++ -- | The `isOnCurve` function validates whether the point is on the curve. It is + -- already utilized within `fromBytesC` deserialization, within hash-to-curve (for+ -- redundant safety) and within `toBytesC` serialization.+ isOnCurve :: a -> Bool++ -- | The `negatePt` function negates a point.+ negatePt :: a -> a++ -- | Returns the (constant) neutral point.+ neutral :: a++ -- | The `pointAdd` function adds two curve points on the same elliptic curve.+ pointAdd :: a -> a -> a++ -- | The `toBytesC` function serializes a point to a (compressed) @ByteStream@.+ toBytesC :: a -> ByteString+++instance (Field f, KnownNat a, KnownNat b, KnownNat baseX, KnownNat baseY) =>+ CurvePt (Point a b baseX baseY f) where++ -- Construct the base point directly from the type literals.+ base = Projective (fromInteger $ BASE_X) (fromInteger $ BASE_Y) 1+++ -- Deserialize a ByteString into a point on the elliptic curve based on section 2.3.4+ -- of https://www.secg.org/sec1-v2.pdf. Only compressed points are supported.+ fromBytesC bytes+ -- If the ByteString is a single zero byte, the Just neutral point is returned+ | length bytes == 1 && index bytes 0 == 0 = Just neutral+ -- If the ByteString is correct length with an acceptable leading byte, attempt decode+ | length bytes == corLen && (index bytes 0 == 0x2 || index bytes 0 == 0x03) = result+ where+ -- correct length is the correct length of the field element plus 1+ corLen = 1 + length (toBytesF (fromInteger (A) :: f))+ -- drop the leading byte then deserialize the x-coordinate+ x = fromBytesF (drop 1 bytes) :: Maybe f+ -- see what sgn0 we are expecting for the final y-coordinate+ sgn0y = if index bytes 0 == 0x02 then 0 else 1 :: Integer+ -- calculate y squared from deserialized x-coordinate and curve constants+ alpha = (\t -> t ^ (3 :: Integer) + ((fromInteger $ A) :: f) * t + ((fromInteger $ B) :: f)) <$> x+ -- get square root (thus a proposed y-coordinate; note y cannot be zero)+ beta = alpha >>= sqrt+ -- adjust which root is selected for y-coordinate+ y = (\t -> if sgn0 t == sgn0y then t else negate t) <$> beta+ -- propose a deserialized point (which is on the curve by construction)+ proposed = (Projective <$> x <*> y <*> Just 1) :: Maybe (Point a b baseX baseY f)+ -- re-validate it is on the curve and return; a sqrt fail propagates through Maybes+ result = mfilter isOnCurve proposed+ -- Otherwise we fail (bad length, bad prefix etc) and return Nothing+ fromBytesC _ = Nothing+++ -- Validate via projective form of Weierstrass equation.+ isOnCurve (Projective x y z) = z * y ^ (2 :: Integer) == x ^ (3 :: Integer) + + fromInteger (A) * x * z ^ (2 :: Integer) + fromInteger (B) * z ^ (3 :: Integer)+++ -- Point negation is flipping y-coordinate.+ negatePt (Projective x y z) = Projective x (- y) z+++ -- Anything with z=0 is neutral (y cannot be 0)+ neutral = Projective 0 1 0+++ -- See https://eprint.iacr.org/2015/1060.pdf page 8; Algorithm 1: Complete, projective + -- point addition for arbitrary (odd) prime order short Weierstrass curves + -- E/Fq : y^2 = x^3 + ax + b. The code has the intermediate additions 'squashed out'+ pointAdd (Projective x1 y1 z1) (Projective x2 y2 z2) = result+ where+ m0 = x1 * x2+ m1 = y1 * y2+ m2 = z1 * z2+ m3 = (x1 + y1) * (x2 + y2)+ m4 = (x1 + z1) * (x2 + z2)+ m5 = (y1 + z1) * (y2 + z2)+ m6 = ((fromInteger $ A) :: f) * (- m0 - m2 + m4)+ m7 = ((fromInteger $ 3 * B) :: f) * m2+ m8 = (m1 - m6 - m7) * (m1 + m6 + m7)+ m9 = ((fromInteger $ A) :: f) * m2+ m10 = ((fromInteger $ 3 * B) :: f) * (- m0 - m2 + m4)+ m11 = ((fromInteger $ A) :: f) * (m0 - m9)+ m12 = (m0 * 3 + m9) * (m10 + m11)+ m13 = (- m1 - m2 + m5) * (m10 + m11)+ m14 = (- m0 - m1 + m3) * (m1 - m6 - m7)+ m15 = (- m0 - m1 + m3) * (m0 * 3 + m9)+ m16 = (- m1 - m2 + m5) * (m1 + m6 + m7)+ result = Projective (-m13 + m14) (m8 + m12) (m15 + m16) :: Point a b baseX baseY f+++ -- Serialize a point on the elliptic curve into a ByteString based on section 2.3.3+ -- of https://www.secg.org/sec1-v2.pdf. Only compressed points are supported.+ --toBytesC (Projective xp yp zp)+ toBytesC pt+ | not $ isOnCurve pt = error "trying to serialize point not on curve" + | _z pt == 0 = pack [0]+ | sgn0 y == 0 = cons 0x02 (toBytesF x)+ | otherwise = cons 0x03 (toBytesF x)+ where -- recover affine coordinates from original projective coordinates+ x = _x pt * inv0 (_z pt)+ y = _y pt * inv0 (_z pt)+++-- | The `Curve` class provides the elliptic point multiplication operation involving+-- one `CurvePt` point on an elliptic curve and another `Field` field element as the+-- scalar operand. It also provides the `mapToCurveSimpleSwu` which is used in the later+-- stages of hashing-to-curve. It supports both the Pallas and Vesta curve point type.+class (CurvePt a, Field b) => Curve a b where++ -- | The `pointMul` function multiplies a field element by a prime-order curve point. + -- This, for example, could be a `PastaCurves.Fq` field element scalar with a + -- `PastaCurves.Pallas` elliptic curve point (which happens to use `PastaCurves.Fp` + -- co-ordinates). + pointMul :: b -> a -> a++ -- The `mapToCurveSimpleSwu` is a simplistic implementation of the Simplified + -- Shallue-van de Woestijne-Ulas method maps a field element to a curve point.+ -- See https://www.ietf.org/archive/id/draft-irtf-cfrg-hash-to-curve-14.html#name-simplified-shallue-van-de-w+ -- It requires A*B != 0 and a special constant Z (see link).+ mapToCurveSimpleSwu :: b -> b -> a+++instance (Field f1, Field f2, KnownNat a, KnownNat b, KnownNat baseX, KnownNat baseY) => + Curve (Point a b baseX baseY f1) f2 where+++ -- Classic double and add algorithm; will add a dedicated point double routine in the future+ pointMul s pt = pointMul' s pt neutral+ where+ pointMul' :: f2 -> Point a b baseX baseY f1 -> Point a b baseX baseY f1 -> Point a b baseX baseY f1+ pointMul' scalar p1 accum+ | scalar == 0 = accum -- scalar is a field element so cannot go 'below zero'+ | sgn0 scalar /= 0 = pointMul' (shiftR1 scalar) doublePt (pointAdd accum p1)+ | sgn0 scalar == 0 = pointMul' (shiftR1 scalar) doublePt accum+ | otherwise = error "pointMul' pattern match fail (should never happen)"+ where+ doublePt = pointAdd p1 p1++ + -- Z is Pasta-specific (constant is calculated elsewhere)+ mapToCurveSimpleSwu fu fz = if A * B /= 0 then result else error "Curve params A*B must not be zero"+ where+ u = (fromInteger $ toI fu) :: f1 -- pesky type conversion + z = (fromInteger $ toI fz) :: f1+ -- See https://www.ietf.org/archive/id/draft-irtf-cfrg-hash-to-curve-14.html#section-6.6.2-7+ tv1 = inv0 (z ^ (2 :: Integer) * u ^ (4 :: Integer) + z * u ^ (2 :: Integer))+ x1a = (fromInteger ((-1) * B) * inv0 (fromInteger (A))) * (1 + tv1)+ x1 = if toI tv1 == 0 then fromInteger (B) * inv0 (z * fromInteger (A)) else x1a + gx1 = x1 ^ (3 :: Integer) + fromInteger (A) * x1 + fromInteger (B)+ x2 = z * u ^ (2 :: Integer) * x1+ gx2 = x2 ^ (3 :: Integer) + fromInteger (A) * x2 + fromInteger (B)+ (x, ya) = if isSqr gx1 then (x1, fromJust $ sqrt gx1) else (x2, fromJust $ sqrt gx2)+ y = if sgn0 u /= sgn0 ya then -ya else ya+ result = Projective x y 1 :: Point a b baseX baseY f1
+ src/Crypto/ECC/Fields.hs view
@@ -0,0 +1,251 @@+{-|+Module : Crypto.PastaCurves.Fields (internal)+Description : Supports the instantiation of parameterized prime-modulus fields.+Copyright : (c) Eric Schorn, 2022+Maintainer : eric.schorn@nccgroup.com+Stability : experimental+Portability : GHC+SPDX-License-Identifier: MIT++This internal module provides a (multi-use) field element template with an arbitrary +prime modulus along with a variety of supporting functionality such as basic arithmetic,+multiplicative inverse, square testing, square root, serialization and deserialization,+and hash2Field. The algorithms are NOT constant time; Safety and simplicity are the top +priorities.+-}++{-# LANGUAGE CPP, DataKinds, DerivingStrategies, KindSignatures, NoImplicitPrelude #-}+{-# LANGUAGE ScopedTypeVariables, Trustworthy #-}++module Fields (Field(..), Fz(..), Num(..)) where++import Prelude hiding (concat, replicate)+import Crypto.Hash (Blake2b_512 (Blake2b_512), hashWith)+import Data.Bifunctor (bimap)+import Data.Bits ((.|.), shiftL, shiftR)+import Data.ByteArray (convert, length, xor)+import Data.ByteString (concat, foldl', pack, replicate)+import Data.ByteString.UTF8 (ByteString, fromString)+import Data.Char (chr)+import Data.Typeable (Proxy (Proxy))+import GHC.Word (Word8)+import GHC.TypeLits (KnownNat, Nat, natVal)+++-- | The `Fz (z :: Nat)` field element (template) type includes a parameterized modulus +-- of @z@.+newtype Fz (z :: Nat) = Fz Integer deriving stock (Eq)+++-- A CPP macro 'helper' to extract the modulus from (Fz z).+#define MOD natVal (Proxy :: Proxy z)+++-- | The `Fz` type is an instance of the `Num` class.+instance KnownNat z => Num (Fz z) where++ fromInteger a = Fz $ a `mod` MOD+ + (+) (Fz a) (Fz b) = fromInteger (a + b)+ + (-) (Fz a) (Fz b) = fromInteger (a - b)++ (*) (Fz a) (Fz b) = fromInteger (a * b)++ abs = error "abs: not implemented/needed"+ + signum = error "signum: not implemented/needed"+++-- | The `Fz` type is an instance of the `Show` class with output in hexadecimal.+instance KnownNat z => Show (Fz z) where++ show (Fz a) = "0x" ++ ["0123456789ABCDEF" !! nibble n | n <- [e, e-1..0]]+ where+ nibble :: Int -> Int+ nibble n = fromInteger $ shiftR a (n*4) `mod` 16+ e = ((3 + until ((MOD <) . (2 ^)) (+ 1) 0) `div` 4) - 1 :: Int+++-- | The `Field` class provides useful support functionality for field elements.+class (Num a, Eq a) => Field a where++ -- | The `fromBytesF` function is the primary deserialization constructor which + -- consumes a big-endian `ByteString` sized to minimally contain the modulus + -- and returns a field element. The deserialized integer must already be properly + -- reduced to reside within [0..modulus), otherwise Nothing is returned.+ fromBytesF :: ByteString -> Maybe a++ -- | The `_fromBytesF` function is the secondary deserialization constructor which+ -- consumes an unconstrained big-endian `ByteString` and returns a internally + -- reduced field element. This function is useful for random testing and + -- hash2Field-style functions.+ _fromBytesF :: ByteString -> a++ -- | The `hash2Field` function provides intermediate functionality that is suitable+ -- for ultimately supporting the `Curves.hash2Curve` function. This function returns+ -- a 2-tuple of field elements.+ hash2Field :: ByteString -> String -> String -> (a, a)++ -- | The `inv0` function returns the multiplicative inverse as calculated by Fermat's+ -- Little Theorem (mapping 0 to 0).+ inv0 :: a -> a++ -- | The `isSqr` function indicates whether the operand has a square root.+ isSqr :: a -> Bool++ -- | The `sgn0` function returns the least significant bit of the field element as an+ -- Integer.+ sgn0 :: a -> Integer++ -- | The `shiftR1` function shifts the field element one bit to the right, effectively + -- dividing it by two (and discarding the remainder).+ shiftR1 :: a -> a++ -- | The `Fields.sqrt` function implements the variable-time Tonelli-Shanks + -- algorithm to calculate the operand's square root. The function returns `Nothing`+ -- in the event of a problem (such as the operand not being a square, the modulus + -- is not prime, etc).+ sqrt :: a -> Maybe a++ -- | The `toBytesF` function serializes an element into a big-endian `ByteString` + -- sized to minimally contain the modulus.+ toBytesF :: a -> ByteString++ -- | The `toI` function returns the field element as a properly reduced Integer.+ toI :: a -> Integer+++-- | The `Fz z` type is an instance of the `Field` class. Several functions are largely +-- simple adapters to the more generic internal functions implemented further below.+instance KnownNat z => Field (Fz z) where++ -- Validated deserialization, returns a Maybe field element. Follows section 2.3.6+ -- of https://www.secg.org/sec1-v2.pdf+ -- If ByteString is not the correct length or integer >= modulus, return Nothing. + -- fromBytesF :: ByteString -> Maybe a+ fromBytesF bytes | Data.ByteArray.length bytes /= corLen || integer >= MOD = Nothing+ | otherwise = Just $ fromInteger integer+ where+ corLen = (7 + until ((MOD <) . (2 ^)) (+ 1) 0) `div` 8 :: Int -- correct length+ integer = foldl' (\a b -> a `shiftL` 8 .|. fromIntegral b) 0 bytes :: Integer+++ -- Unvalidated deserialization (no limits wrt modulus), returns reduced field element.+ -- _fromBytesF :: ByteString -> a+ _fromBytesF bytes = fromInteger $ foldl' (\a b -> shiftL a 8 .|. fromIntegral b) 0 bytes+++ -- Field-level support for the hash2Curve function, returns a pair of field elements.+ -- The hash2field construction is per Zcash Pasta Curve (which is very similar but not + -- identical to the CFRG hash-to-curve specification). Fortuitously, cryptonite sets+ -- the hash personalization to all zeros, see https://github.com/haskell-crypto/cryptonite/issues/333+ -- Zcash/Pasta code https://github.com/zcash/pasta_curves/blob/main/src/hashtocurve.rs#L10+ -- CFRG scheme (for ref) https://www.ietf.org/archive/id/draft-irtf-cfrg-hash-to-curve-14.html#name-hash_to_field-implementatio+ -- Length of domain prefix and curve ID need to be less than 256 - 22 + -- hash2Field :: ByteString -> String -> String -> (a, a)+ hash2Field msg domPref curveId + | 22 + Prelude.length curveId + Prelude.length domPref > 255 = error "strings too long"+ | otherwise = bimap _fromBytesF _fromBytesF (digest1, digest2)+ where+ -- Calculate reusable prefix and suffix+ prefix = replicate 128 0+ suffix = fromString (domPref ++ "-" ++ curveId ++ "_XMD:BLAKE2b_SSWU_RO_" +++ [chr (22 + Prelude.length curveId + Prelude.length domPref)])+ -- A little helper function to hash ByteStrings+ mkDigest :: ByteString -> ByteString+ mkDigest x = convert $ hashWith Blake2b_512 x+ -- Hash the message along with prefix, suffix, etc + digest0 = mkDigest $ concat [prefix, msg, pack [0,0x80,0], suffix]+ -- Hash the hash again+ digest1 = mkDigest $ concat [digest0, pack [0x01], suffix]+ -- Mix the two above hashes together via bytewise XOR, then hash that too+ mix = xor digest0 digest1 :: ByteString+ digest2 = mkDigest $ concat [mix, pack [0x02], suffix]+++ -- Multiplicative inverse, with 0 mapped to 0, via Fermat's Little Theorem+ -- inv0 :: a -> a+ inv0 (Fz a) = Fz $ _powMod a (MOD - 2) (MOD)+++ -- Determines if the operand has a square root. Uses helper functions with Integers+ -- isSqr :: a -> Bool+ isSqr (Fz a) = _isSqr a (MOD)+++ -- Returns the least significant bit of the field element as an Integer+ -- sgn0 :: a -> Integer+ sgn0 (Fz a) = a `mod` 2+++ -- Shift right by 1 (divides the element by 2, discarding the remainder)+ -- shiftR1 :: a -> a+ shiftR1 (Fz a) = Fz $ a `div` 2+++ -- Returns square root as Maybe field element. If any problems, returns Nothing.+ -- sqrt :: a -> Maybe a+ sqrt (Fz a) = fromInteger <$> _sqrtVt a (MOD) s p c -- Use helper function+ where + -- rewrite (modulus - 1) as p * 2**s + s = until ((/= 0) . ((MOD -1) `rem`) . (2 ^)) (+ 1) 0 - 1 :: Integer+ p = (MOD - 1) `div` (2 ^ s)+ -- Find first non-square and use that to prepare \'fountain of fixes\'+ z = head ([x | x <- [1..], not (_isSqr x (MOD))] ++ [0])+ c = _powMod z p (MOD)+++ -- Deserialization. Follows section 2.3.7 of https://www.secg.org/sec1-v2.pdf+ -- toBytesF :: a -> ByteString+ toBytesF (Fz a) = pack $ reverse res+ where+ corLen = fromInteger $ (7 + until ((MOD <) . (2 ^)) (+ 1) 0) `div` 8 :: Int+ res = [fromIntegral (shiftR a (8*b)) | b <- [0..(corLen - 1)]] :: [Word8]+++ -- Returns the element as an Integer+ -- toI :: a -> Integer + toI (Fz a) = a+++-- Complex/common support functions operating on integers rather than field elements++-- | Modular exponentiation.+-- _powMod :: operand -> exponent -> modulus+_powMod :: Integer -> Integer -> Integer -> Integer+_powMod _ e q | e < 0 || q < 2 = error "Invalid exponent/modulus"+_powMod _ 0 _ = 1+_powMod a 1 _ = a+_powMod a e q | even e = _powMod (a * a `mod` q) (shiftR e 1) q+ | otherwise = a * _powMod a (e - 1) q `mod` q+++-- | Is operand a square via Legendre symbol.+-- isSqr :: operand -> modulus+_isSqr :: Integer -> Integer -> Bool+_isSqr a q = (legendreSymbol == 0) || (legendreSymbol == 1)+ where legendreSymbol = _powMod a ((q - 1) `div` 2) q+++-- | Variable-time Tonelli-Shanks algorithm. Works with any prime modulus.+-- _sqrtVt :: operand -> modulus -> \'s\' -> \'p\' -> nonSquare+_sqrtVt :: Integer -> Integer -> Integer -> Integer -> Integer -> Maybe Integer+_sqrtVt 0 _ _ _ _ = Just 0+_sqrtVt a q _ _ _ | not (_isSqr a q) = Nothing -- Not truly necessary+_sqrtVt _ _ _ _ 0 = Nothing -- covers the bases+_sqrtVt a q s p c = Just result+ where+ t = _powMod a p q+ r = _powMod a ((p + 1) `div` 2) q+ result = loopy t r c s -- recursively iterate the function below+ loopy :: Integer -> Integer -> Integer -> Integer -> Integer+ loopy tt _ _ ss | tt == 0 || ss == 0 = 0+ loopy 1 rr _ _ = rr+ loopy tt rr cc ss = loopy t_n r_n c_n s_n -- read _n as _next+ where+ s_n = head ([i | i <- [1..(ss - 1)], _powMod tt (2 ^ i) q == 1] ++ [0]) -- ++0 avoids empty+ ff = _powMod cc (2 ^ (ss - s_n - 1)) q+ r_n = rr * ff `mod` q+ t_n = (tt * _powMod ff 2 q) `mod` q+ c_n = _powMod cc (2 ^ (ss - s_n)) q
+ src/Crypto/ECC/Pasta.hs view
@@ -0,0 +1,147 @@+{-|+Module : Crypto.PastaCurves.Pasta (internal)+Description : Pasta-specific instantiation of parameterized curves and fields.+Copyright : (c) Eric Schorn, 2022+Maintainer : eric.schorn@nccgroup.com+Stability : experimental+Portability : GHC+SPDX-License-Identifier: MIT++This internal module instantiates the specific curves and fields specific to Pasta. It+also includes `hashToPallas` and `hashToVesta` functionality (which in turn includes+two isogenous curves, mapping functionality, and coefficient vectors). The algorithms +are NOT constant time; Safety and simplicity are the top priorities.+-}++{-# LANGUAGE DataKinds, NoImplicitPrelude, Safe #-}++module Pasta (Fp, Fq, Num(..), Pallas, Vesta, Curve(..), CurvePt(..), Field(..), + hashToPallas, hashToVesta, pallasPrime, vestaPrime) where++import Prelude+import Curves (Curve(..), CurvePt(..), Point(..))+import Fields (Fz, Field(..))+import Data.ByteString.UTF8 (ByteString)+++-- | `Fp` is the field element used as a coordinate in the Pallas elliptic curve.+-- It is a type synonym for the internal `Fields.Fz` type, parameterized with the +-- correct modulus. It is also typically used as a scalar to multiply a Vesta elliptic+-- curve point. Note that pointMul does not enforce specific scalar/point combinations.+type Fp = Fz 0x40000000000000000000000000000000224698fc094cf91b992d30ed00000001+++-- | `Pallas` represents a point on the Pallas elliptic curve using `Fp` coordinates.+-- The curve was designed to have the some order as the `Fq` element\'s modulus. It is+-- a type synonym for the internal `Curves.Point` type, parameterized with the curve\s +-- @a@ and @b@ values and the affine base point as @base_x@ and @base_y@. The underlying+-- point is of type @Point a b base_x base_y field@.+type Pallas = (Point 0 5 1 0x248b4a5cf5ed6c83ac20560f9c8711ab92e13d27d60fb1aa7f5db6c93512d546 Fp)+++-- | `Fq` is the field element used as a coordinate in the Vesta elliptic curve.+-- It is a type synonym for the internal `Fields.Fz` type, parameterized with the +-- correct modulus. It is also typically used as a scalar to multiply a Pallas elliptic +-- curve point. Note that pointMul does not enforce specific scalar/point combinations.+type Fq = Fz 0x40000000000000000000000000000000224698fc0994a8dd8c46eb2100000001+++-- | `Vesta` represents a point on the Vesta elliptic curve using `Fq` coordinates.+-- The curve was designed to have the some order as the `Fp` element\'s modulus. It is+-- a type synonym for the internal `Curves.Point` type, parameterized with the curve\s +-- @a@ and @b@ values and the affine base point as @base_x@ and @base_y@. The underlying+-- point is of type @Point a b base_x base_y field@.+type Vesta = (Point 0 5 1 0x26bc999156dd5194ec49b1c551768ab375785e7ce00906d13e0361674fd8959f Fq)+++-- This is a curve that is isogenous to Pallas, but with a*b != 0; base point params are unused+type IsoPallas = (Point 0x18354a2eb0ea8c9c49be2d7258370742b74134581a27a59f92bb4b0b657a014b 1265 0 0 Fp)+++-- This is a curve that is isogenous to Vesta, but with a*b != 0; base point params are unused+type IsoVesta = (Point 0x267f9b2ee592271a81639c4d96f787739673928c7d01b212c515ad7242eaa6b1 1265 0 0 Fq)+++-- | The `hashToPallas` function takes an arbitrary `ByteString` and maps it to a valid +-- point on the Pallas elliptic curve (of unknown relation to the base point).+hashToPallas :: ByteString -> Pallas+hashToPallas msg = result + where+ (fe0, fe1) = hash2Field msg "z.cash:test" "pallas" :: (Fp, Fp)+ q0 = mapToCurveSimpleSwu fe0 (fromInteger (-13)) :: IsoPallas -- -13 is Pasta specific magic constant+ q1 = mapToCurveSimpleSwu fe1 (fromInteger (-13)) :: IsoPallas+ (Projective xp yp zp) = pointAdd q0 q1 :: IsoPallas+ x = xp * inv0 zp ; y = yp * inv0 zp+ xTop = head isoPallasVecs * x ^ (3::Integer) + isoPallasVecs !! 1 * x ^ (2::Integer) + isoPallasVecs !! 2 * x + isoPallasVecs !! 3+ xBot = x ^ (2::Integer) + isoPallasVecs !! 4 * x + isoPallasVecs !! 5+ yTop = isoPallasVecs !! 6 * x ^ (3::Integer) + isoPallasVecs !! 7 * x ^ (2::Integer) + isoPallasVecs !! 8 * x + isoPallasVecs !! 9+ yBot = x ^ (3::Integer) + isoPallasVecs !! 10 * x ^ (2::Integer) + isoPallasVecs !! 11 * x + isoPallasVecs !! 12 + proposed = Projective (xTop * inv0 xBot) (y * yTop * inv0 yBot) 1 :: Pallas+ result = if isOnCurve proposed then proposed else error "hashed to Pallas non-point"+++-- | The `hashToVesta` function takes an arbitrary `ByteString` and maps it to a valid +-- point on the Vesta elliptic curve (of unknown relation to the base point).+hashToVesta :: ByteString -> Vesta+hashToVesta msg = result + where+ (fe0, fe1) = hash2Field msg "z.cash:test" "vesta" :: (Fq, Fq)+ q0 = mapToCurveSimpleSwu fe0 (fromInteger (-13)) :: IsoVesta+ q1 = mapToCurveSimpleSwu fe1 (fromInteger (-13)) :: IsoVesta+ (Projective xp yp zp) = pointAdd q0 q1 :: IsoVesta+ x = xp * inv0 zp ; y = yp * inv0 zp+ xTop = head isoVestaVecs * x ^ (3::Integer) + isoVestaVecs !! 1 * x ^ (2::Integer) + isoVestaVecs !! 2 * x + isoVestaVecs !! 3+ xBot = x ^ (2::Integer) + isoVestaVecs !! 4 * x + isoVestaVecs !! 5+ yTop = isoVestaVecs !! 6 * x ^ (3::Integer) + isoVestaVecs !! 7 * x ^ (2::Integer) + isoVestaVecs !! 8 * x + isoVestaVecs !! 9+ yBot = x ^ (3::Integer) + isoVestaVecs !! 10 * x ^ (2::Integer) + isoVestaVecs !! 11 * x + isoVestaVecs !! 12 + proposed = Projective (xTop * inv0 xBot) (y * yTop * inv0 yBot) 1 :: Vesta+ result = if isOnCurve proposed then proposed else error "hashed to Vesta non-point"+++-- | The Pallas field modulus https://neuromancer.sk/std/other/Pallas+pallasPrime :: Integer+pallasPrime = 0x40000000000000000000000000000000224698fc094cf91b992d30ed00000001+++-- | The Vesta field modulus https://neuromancer.sk/std/other/Vesta+vestaPrime :: Integer+vestaPrime = 0x40000000000000000000000000000000224698fc0994a8dd8c46eb2100000001+++-- Vectors to map isogenous curve (with a*b != 0) point to Pallas+-- See https://github.com/zcash/pasta_curves/blob/21fd9e2c1bbd2d049bfe95588d77cb884e9f93ab/src/curves.rs#L1017-L1096+isoPallasVecs :: [Fp]+isoPallasVecs = [+ 0x0e38e38e38e38e38e38e38e38e38e38e4081775473d8375b775f6034aaaaaaab,+ 0x3509afd51872d88e267c7ffa51cf412a0f93b82ee4b994958cf863b02814fb76,+ 0x17329b9ec525375398c7d7ac3d98fd13380af066cfeb6d690eb64faef37ea4f7,+ 0x1c71c71c71c71c71c71c71c71c71c71c8102eea8e7b06eb6eebec06955555580,+ 0x1d572e7ddc099cff5a607fcce0494a799c434ac1c96b6980c47f2ab668bcd71f,+ 0x325669becaecd5d11d13bf2a7f22b105b4abf9fb9a1fc81c2aa3af1eae5b6604,+ 0x1a12f684bda12f684bda12f684bda12f7642b01ad461bad25ad985b5e38e38e4,+ 0x1a84d7ea8c396c47133e3ffd28e7a09507c9dc17725cca4ac67c31d8140a7dbb,+ 0x3fb98ff0d2ddcadd303216cce1db9ff11765e924f745937802e2be87d225b234,+ 0x025ed097b425ed097b425ed097b425ed0ac03e8e134eb3e493e53ab371c71c4f,+ 0x0c02c5bcca0e6b7f0790bfb3506defb65941a3a4a97aa1b35a28279b1d1b42ae,+ 0x17033d3c60c68173573b3d7f7d681310d976bbfabbc5661d4d90ab820b12320a,+ 0x40000000000000000000000000000000224698fc094cf91b992d30ecfffffde5]+++-- Vectors to map isogenous curve (with a*b != 0) point to Vesta+-- Curve isogenous to Vesta, with a*b != 0+-- See https://github.com/zcash/pasta_curves/blob/21fd9e2c1bbd2d049bfe95588d77cb884e9f93ab/src/curves.rs#L1117-L1196+isoVestaVecs :: [Fq]+isoVestaVecs = [+ 0x38e38e38e38e38e38e38e38e38e38e390205dd51cfa0961a43cd42c800000001,+ 0x1d935247b4473d17acecf10f5f7c09a2216b8861ec72bd5d8b95c6aaf703bcc5,+ 0x18760c7f7a9ad20ded7ee4a9cdf78f8fd59d03d23b39cb11aeac67bbeb586a3d,+ 0x31c71c71c71c71c71c71c71c71c71c71e1c521a795ac8356fb539a6f0000002b,+ 0x0a2de485568125d51454798a5b5c56b2a3ad678129b604d3b7284f7eaf21a2e9,+ 0x14735171ee5427780c621de8b91c242a30cd6d53df49d235f169c187d2533465,+ 0x12f684bda12f684bda12f684bda12f685601f4709a8adcb36bef1642aaaaaaab,+ 0x2ec9a923da239e8bd6767887afbe04d121d910aefb03b31d8bee58e5fb81de63,+ 0x19b0d87e16e2578866d1466e9de10e6497a3ca5c24e9ea634986913ab4443034,+ 0x1ed097b425ed097b425ed097b425ed098bc32d36fb21a6a38f64842c55555533,+ 0x2f44d6c801c1b8bf9e7eb64f890a820c06a767bfc35b5bac58dfecce86b2745e,+ 0x3d59f455cafc7668252659ba2b546c7e926847fb9ddd76a1d43d449776f99d2f,+ 0x40000000000000000000000000000000224698fc0994a8dd8c46eb20fffffde5]
+ src/Crypto/ECC/PastaCurves.hs view
@@ -0,0 +1,80 @@+{-|+Module : Crypto.PastaCurves.PastaCurves+Description : Provides the overall Pasta curve and field functionality.+Copyright : (c) Eric Schorn, 2022+Maintainer : eric.schorn@nccgroup.com+Stability : experimental+Portability : GHC+SPDX-License-Identifier: MIT++This module provides the Pasta Curves consisting of: the `Pallas` curve and its `Fp` +field element, the `Vesta` curve and its `Fq` field element, and a variety of +supporting functionality such as point/element arithmetic, serialization, and +hash-to-curve. The algorithms are NOT constant time; Safety and simplicity are the top +priorities.++\[+\text{Pallas: } y^2 = x^3 + 5 \text{ over } F_p(0x40000000000000000000000000000000224698fc094cf91b992d30ed00000001)+\]+ +\[+\text{Vesta: } y^2 = x^3 + 5 \text{ over } F_q(0x40000000000000000000000000000000224698fc0994a8dd8c46eb2100000001)+\]++The order of the Pallas curve is 0x40000000000000000000000000000000224698fc0994a8dd8c46eb2100000001.++The order of the Vesta curve is 0x40000000000000000000000000000000224698fc094cf91b992d30ed00000001.++The curves are designed such that the order of one matches the field characteristic of+the other. For a brief introduction, see the Zcash blog titled "The Pasta Curves for Halo +2 and Beyond" at <https://electriccoin.co/blog/the-pasta-curves-for-halo-2-and-beyond/>.+The reference Rust implementation (which inspired this implementation) can be found at:+<https://github.com/zcash/pasta_curves>.++Example usage of this library implementation:++@+$ cabal repl++ghci> a = 9 :: Fp++ghci> a*a+0x0000000000000000000000000000000000000000000000000000000000000051++ghci> pointMul a base :: Vesta+Projective {_px = 0x3CDC6A090F2BB3B52714C083929B620FE24ADBCBBD420752108CD7C29E543E5E, + _py = 0x08795CD330B3CE5AA63BD2B18DE155AE3C96E8AF9DA2CC742C6BA1464E490161, + _pz = 0x1FA26F58F3A641ADFE81775D3D53378D6178B6CCBF14F9BD4AB5F10DEE28D878}+@++-}++{-# LANGUAGE DataKinds, NoImplicitPrelude, Safe #-}++module PastaCurves (Fp, Fq, Pallas, Vesta, CurvePt(..), Curve(..), hashToPallas, + hashToVesta, Field(..), pallasPrime, vestaPrime, exampleFp, exampleFq, examplePallasPt, + exampleVestaPt, Num(..)) where++import Pasta (Fp, Fq, Num(..), Pallas, Vesta, CurvePt(..), Curve(..), Field(..), + hashToPallas, hashToVesta, pallasPrime, vestaPrime)+import Data.ByteString.UTF8 (fromString)+++-- | An example `Fp` element (8).+exampleFp :: Fp+exampleFp = 8+++-- | An example `Fq` element (999).+exampleFq :: Fq+exampleFq = 999+++-- | An example `Pallas` point generated by hashing a message.+examplePallasPt :: Pallas+examplePallasPt = hashToPallas (fromString "A message to hash")+++-- | An example `Vesta` point (base * 8).+exampleVestaPt :: Vesta+exampleVestaPt = pointMul exampleFp base
+ test/Spec.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE NoImplicitPrelude, Trustworthy #-}++module Main (main) where++import Prelude+import System.Environment (setEnv)+import Test.Tasty (defaultMain, testGroup)+import TestFields (fieldProps, testBadF, testGoodF)+import TestCurves (curveProps, testHashToPallas, testHashToVesta, testPOI, testBadC, testPallasEq)+++main :: IO ()+main = do+ setEnv "TASTY_QUICKCHECK_TESTS" "1_000"+ defaultMain $ testGroup "\nRunning Tests" [fieldProps, testBadF, testGoodF,+ testHashToPallas, testHashToVesta, curveProps, testPOI, testBadC, testPallasEq]+ print "Finished!"
+ test/TestCurves.hs view
@@ -0,0 +1,122 @@+-- Test curves...++{-# LANGUAGE FlexibleInstances, NoImplicitPrelude, Trustworthy #-}+{-# OPTIONS_GHC -Wno-orphans #-}++module TestCurves (curveProps, testPOI, testHashToPallas, testHashToVesta, testBadC, testPallasEq) where++import Prelude hiding (exp)+import Data.ByteString (pack)+import Data.ByteString.UTF8 (fromString)+import Data.Maybe (fromJust, isNothing)+import Data.Word (Word8)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, testCase)+import Test.Tasty.QuickCheck (Arbitrary(..), testProperty)+import TestFields ()+import PastaCurves+import Curves (Point(Projective))+++instance Arbitrary Pallas where+ arbitrary = do+ scalar <- arbitrary+ return $ pointMul (scalar :: Fq) (base :: Pallas) +++instance Arbitrary Vesta where+ arbitrary = do+ scalar <- arbitrary+ return $ pointMul (scalar :: Fp) (base :: Vesta) +++curveProps :: TestTree+curveProps = testGroup "Testing Curve properties via QuickCheck" [++ testProperty "Pallas point add/mul" $ + \x y -> pointAdd (pointMul (x :: Fq) base) (pointMul y base) == pointMul (x+y) (base::Pallas),+ testProperty "Pallas point add symm" $+ \x y -> pointAdd x y == pointAdd y (x :: Pallas),+ testProperty "Pallas ser->deser" $+ \x -> fromJust (fromBytesC (toBytesC x)) == (x :: Pallas),++ testProperty "Vesta point add/mul" $ + \x y -> pointAdd (pointMul (x :: Fp) base) (pointMul y base) == pointMul (x+y) (base :: Vesta),+ testProperty "Vesta point add symm" $+ \x y -> pointAdd x y == pointAdd y (x :: Vesta),+ testProperty "Vesta ser->deser" $+ \x -> fromJust (fromBytesC (toBytesC x)) == (x :: Vesta)+ ] +++testPOI :: TestTree+testPOI = testCase "poi decode" $+ do+ let poiBytes = pack [0]+ let orderLessOne = (0::Fq) - 1+ let act = pointAdd (pointMul orderLessOne base) base :: Pallas+ let actBytes = toBytesC act+ assertBool "bad pairing mul" (poiBytes == actBytes)+ assertBool "point point eq" (act == (neutral :: Pallas))+++testBadC :: TestTree+testBadC = testCase "bad decode" $ do+ let tooFewBytes = pack [0, 0]+ let act1 = fromBytesC tooFewBytes :: Maybe Pallas+ assertBool "bad too short bytes" (isNothing act1)+ let tooManyBytes = pack $ replicate 34 0+ let act2 = fromBytesC tooManyBytes :: Maybe Pallas+ assertBool "bad too many bytes" (isNothing act2)+ let tooLargeValue = pack $ (0x02 :: Word8) : (0x41 :: Word8) : replicate 31 0+ let act3 = fromBytesC tooLargeValue :: Maybe Pallas+ assertBool "bad too large value" (isNothing act3)+ let notOnCurve = pack $ (0x02 :: Word8) : replicate 32 0+ let act4 = fromBytesC notOnCurve :: Maybe Pallas+ assertBool "bad not on curve" (isNothing act4)+ let baseBytes = pack $ ((0x02 :: Word8) : replicate 31 0) ++ [0x01 :: Word8]+ let act5 = fromBytesC baseBytes :: Maybe Pallas+ assertBool "bad is base" $ fromJust act5 == (base :: Pallas)+ let notBaseBytes = pack $ ((0x03 :: Word8) : replicate 31 0) ++ [0x01 :: Word8]+ let act6 = fromBytesC notBaseBytes :: Maybe Pallas+ assertBool "bad not base" $ fromJust act6 /= (base :: Pallas)+++testPallasEq :: TestTree+testPallasEq = testCase "bad Eq" $ do+ let x1 = 0x2e341f9b583ed433336de60408dc32487b37d8076f09ed1cd25e4f406c46f0bc :: Fp+ let y1 = 0x285a83a7d3a0d903aa1bb19eb6894d7dca04b13687abf05423ce54362de3d5de :: Fp+ let z1 = 1 :: Fp+ let x2 = 0x24024b8e1f42b83c83c211405147f74209b30aca025efc773734e7163798eb77 :: Fp+ let y2 = 0x27db4a65be914fba5eac9c613554e58b4469b8eb344e937511f48b1780d9ab70 :: Fp+ let z2 = 1 :: Fp+ let x3 = 0x1dc72099914e05a28ce349b110c6f52291eb1cec24643bbed1fb489f7cb41f47 :: Fp+ let y3 = 0x01b1f3ee3ec752c0a9022c1c2e178d00c10aa97417236f91a49ab232ec347c4f :: Fp+ let z3 = 1 :: Fp+ assertBool "Bad Eq1" $ ((Projective x1 y1 z1) :: Pallas) /= (Projective x2 y2 z2)+ assertBool "Bad Eq2" $ ((Projective x2 y2 z2) :: Pallas) /= (Projective x3 y3 z3)+ assertBool "Bad Eq3" $ ((Projective x3 y3 z3) :: Pallas) /= (Projective x1 y1 z1)+++testHashToPallas :: TestTree+testHashToPallas = testCase "testHashToPallas" $ assertBool "Failed testHashToPallas" helper+ where+ actual = hashToPallas (fromString "Trans rights now!") -- String from zcash test vector line 147 (link below)+ -- See https://github.com/zcash/pasta_curves/blob/21fd9e2c1bbd2d049bfe95588d77cb884e9f93ab/src/pallas.rs#L150-L158+ z = 0x1d48103df8fcbb70d1809c1806c95651dd884a559fec0549658537ce9d94bed9 :: Fp+ x = 0x36a6e3a9c50b7b6540cb002c977c82f37f8a875fb51eb35327ee1452e6ce7947 * inv0 (z ^ (2::Integer))+ y = 0x01da3b4403d73252f2d7e9c19bc23dc6a080f2d02f8262fca4f7e3d756ac6a7c * inv0 (z ^ (3::Integer))+ expected = Projective x y 1 :: Pallas + helper = actual == expected+++testHashToVesta :: TestTree+testHashToVesta = testCase "testHashToVesta" $ assertBool "Failed testHashToVesta" helper+ where+ actual = hashToVesta (fromString "hello") -- String from zcash test vector line 147 (link below)+ -- See https://github.com/zcash/pasta_curves/blob/21fd9e2c1bbd2d049bfe95588d77cb884e9f93ab/src/vesta.rs#L63-L71+ z = 0x1b58d4aa4d68c3f4d9916b77c79ff9911597a27f2ee46244e98eb9615172d2ad :: Fq+ x = 0x12763505036e0e1a6684b7a7d8d5afb7378cc2b191a95e34f44824a06fcbd08e * inv0 (z ^ (2::Integer))+ y = 0x0256eafc0188b79bfa7c4b2b393893ddc298e90da500fa4a9aee17c2ea4240e6 * inv0 (z ^ (3::Integer))+ expected = Projective x y 1 :: Vesta+ helper = actual == expected
+ test/TestFields.hs view
@@ -0,0 +1,63 @@+-- Test fields...++{-# LANGUAGE DataKinds, FlexibleInstances, NoImplicitPrelude, OverloadedStrings, Trustworthy #-}+{-# OPTIONS_GHC -Wno-orphans -Wno-unrecognised-pragmas #-}+{-# HLINT ignore "Redundant bracket" #-}++module TestFields (fieldProps, testBadF, testGoodF) where++import Prelude hiding (sqrt)+import Data.ByteString (pack)+import Data.Maybe (fromJust, isNothing)+import Data.Word (Word8)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (testCase, assertBool)+import Test.Tasty.QuickCheck (Arbitrary(..), choose, testProperty)+import PastaCurves+++instance Arbitrary Fp where+ arbitrary = fromInteger <$> choose (0, 2 ^ (512::Integer))++instance Arbitrary Fq where+ arbitrary = fromInteger <$> choose (0, 2 ^ (512::Integer))+++fieldProps :: TestTree+fieldProps = testGroup "Testing Field properties via QuickCheck" [+ testProperty "Fp arith" $ \a b c -> a*(b-c) - a*b + a*c == (0 :: Fp),+ testProperty "Fp inv0" $ \a -> a * inv0 a == (1 :: Fp),+ testProperty "Fp sqrt" $ \a -> fromJust (sqrt (a*a)) ^ (2 :: Integer) == (a ^ (2 :: Integer) :: Fp),+ testProperty "Fp isSqr" $ \a -> isSqr (a*a :: Fp),+ testProperty "Fp serdes" $ \a -> fromBytesF (toBytesF a) == Just (a :: Fp),+ testProperty "Fp shiftR1" $ \a -> shiftR1 a == fromInteger (toI (a :: Fp) `div` 2),++ testProperty "Fq arith" $ \a b c -> a*(b-c) - a*b + a*c == (0 :: Fq),+ testProperty "Fq inv0" $ \a -> a * inv0 a == (1 :: Fq),+ testProperty "Fq sqrt" $ \a -> fromJust (sqrt (a*a)) ^ (2 :: Integer) == (a ^ (2 :: Integer) :: Fq),+ testProperty "Fq isSqr" $ \a -> isSqr (a*a :: Fq),+ testProperty "Fq serdes" $ \a -> fromBytesF (toBytesF a) == Just (a :: Fq),+ testProperty "Fq shiftR1" $ \a -> shiftR1 a == fromInteger (toI (a :: Fq) `div` 2)+ ]+++testBadF :: TestTree+testBadF = testCase "testBadF" $+ do+ let tooFewBytes = pack [0]+ let act1 = fromBytesF tooFewBytes :: Maybe Fq+ assertBool "bad too short bytes" (isNothing act1)+ let tooManyBytes = pack $ replicate 33 0+ let act2 = fromBytesF tooManyBytes :: Maybe Fq+ assertBool "bad too many bytes" (isNothing act2)+ let tooLargeValue = pack $ (0x41 :: Word8) : replicate 31 0+ let act3 = fromBytesF tooLargeValue :: Maybe Fq+ assertBool "bad too large value" (isNothing act3)++testGoodF :: TestTree+testGoodF = testCase "testGoodF" $+ do+ assertBool "sgn0 -1" (sgn0 (negate (1 :: Fq)) == 0)+ assertBool "sgn0 1" (sgn0 (1 :: Fq) == 1)+ -- hash2Field tested as part of hash2Curve+