diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,5 +7,12 @@ * Initially created. +## 0.0.1.0 + +* Dropped (minimum required) cabal version to improve compatibility +* Added functions to generate A) invertible random field element, and B) random Pallas/Vesta curve point +* Added `Bounded` instances to field elements + + [1]: https://pvp.haskell.org [2]: https://github.com/nccgroup/pasta-curves/releases diff --git a/pasta-curves.cabal b/pasta-curves.cabal --- a/pasta-curves.cabal +++ b/pasta-curves.cabal @@ -1,6 +1,6 @@ -cabal-version: 3.0 +cabal-version: 2.4 name: pasta-curves -version: 0.0.0.0 +version: 0.0.1.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. @@ -30,7 +30,8 @@ utf8-string >= 1 && < 1.0.3, cryptonite >= 0.29 && < 0.31, memory >= 0.16 && < 0.18, - bytestring >= 0.10 && < 0.11.4 + bytestring >= 0.10 && < 0.11.4, + random >= 1.1 && < 1.3 other-modules: Curves, Fields, Pasta ghc-options: -Weverything -Wno-missing-import-lists diff --git a/src/Crypto/ECC/Curves.hs b/src/Crypto/ECC/Curves.hs --- a/src/Crypto/ECC/Curves.hs +++ b/src/Crypto/ECC/Curves.hs @@ -156,6 +156,9 @@ m16 = (- m1 - m2 + m5) * (m1 + m6 + m7) result = Projective (-m13 + m14) (m8 + m12) (m15 + m16) :: Point a b baseX baseY f + -- Note that point doubling from algorithm 3 on page 10 would require around "13" + -- multiplications (not much/enough performance benefit) + -- 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. diff --git a/src/Crypto/ECC/Fields.hs b/src/Crypto/ECC/Fields.hs --- a/src/Crypto/ECC/Fields.hs +++ b/src/Crypto/ECC/Fields.hs @@ -27,9 +27,11 @@ import Data.ByteString (concat, foldl', pack, replicate) import Data.ByteString.UTF8 (ByteString, fromString) import Data.Char (chr) +import Data.Tuple (swap) import Data.Typeable (Proxy (Proxy)) import GHC.Word (Word8) import GHC.TypeLits (KnownNat, Nat, natVal) +import System.Random (Random(randomR), RandomGen) -- | The `Fz (z :: Nat)` field element (template) type includes a parameterized modulus @@ -67,6 +69,13 @@ e = ((3 + until ((MOD <) . (2 ^)) (+ 1) 0) `div` 4) - 1 :: Int +instance KnownNat z => Bounded (Fz z) where + + minBound = 0 + + maxBound = fromInteger $ MOD - 1 + + -- | The `Field` class provides useful support functionality for field elements. class (Num a, Eq a) => Field a where @@ -94,6 +103,9 @@ -- | The `isSqr` function indicates whether the operand has a square root. isSqr :: a -> Bool + -- | The `rndF` function returns a random (invertible/non-zero) field element. + rndF :: (RandomGen r) => r -> (r, a) + -- | The `sgn0` function returns the least significant bit of the field element as an -- Integer. sgn0 :: a -> Integer @@ -172,6 +184,10 @@ -- Determines if the operand has a square root. Uses helper functions with Integers -- isSqr :: a -> Bool isSqr (Fz a) = _isSqr a (MOD) + + + -- The `rndF` function returns a random (invertible/non-zero) field element. + rndF rndGen = fromInteger <$> swap (randomR (1, MOD - 1) rndGen) -- Returns the least significant bit of the field element as an Integer diff --git a/src/Crypto/ECC/Pasta.hs b/src/Crypto/ECC/Pasta.hs --- a/src/Crypto/ECC/Pasta.hs +++ b/src/Crypto/ECC/Pasta.hs @@ -13,15 +13,16 @@ are NOT constant time; Safety and simplicity are the top priorities. -} -{-# LANGUAGE DataKinds, NoImplicitPrelude, Safe #-} +{-# LANGUAGE DataKinds, NoImplicitPrelude, ScopedTypeVariables, Safe #-} module Pasta (Fp, Fq, Num(..), Pallas, Vesta, Curve(..), CurvePt(..), Field(..), - hashToPallas, hashToVesta, pallasPrime, vestaPrime) where + hashToPallas, hashToVesta, rndPallas, rndVesta, pallasPrime, vestaPrime) where import Prelude import Curves (Curve(..), CurvePt(..), Point(..)) import Fields (Fz, Field(..)) import Data.ByteString.UTF8 (ByteString) +import System.Random (RandomGen) -- | `Fp` is the field element used as a coordinate in the Pallas elliptic curve. @@ -96,6 +97,16 @@ 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 `rndPallas` function returns a random Pallas point when given a StdGen. +rndPallas :: forall g. RandomGen g => g -> (g, Pallas) +rndPallas rndGen = hashToPallas . toBytesF <$> (rndF rndGen :: (g, Fq)) + + +-- | The `rndVesta` function returns a random Vests point when given a StdGen. +rndVesta :: forall g. RandomGen g => g -> (g, Vesta) +rndVesta rndGen = hashToVesta . toBytesF <$> (rndF rndGen :: (g, Fp)) -- | The Pallas field modulus https://neuromancer.sk/std/other/Pallas diff --git a/src/Crypto/ECC/PastaCurves.hs b/src/Crypto/ECC/PastaCurves.hs --- a/src/Crypto/ECC/PastaCurves.hs +++ b/src/Crypto/ECC/PastaCurves.hs @@ -51,12 +51,12 @@ {-# LANGUAGE DataKinds, NoImplicitPrelude, Safe #-} -module PastaCurves (Fp, Fq, Pallas, Vesta, CurvePt(..), Curve(..), hashToPallas, - hashToVesta, Field(..), pallasPrime, vestaPrime, exampleFp, exampleFq, examplePallasPt, - exampleVestaPt, Num(..)) where +module PastaCurves (Fp, Fq, Pallas, Vesta, CurvePt(..), Curve(..), hashToPallas, + hashToVesta, rndPallas, rndVesta, Field(..), pallasPrime, vestaPrime, exampleFp, + exampleFq, examplePallasPt, exampleVestaPt, Num(..)) where import Pasta (Fp, Fq, Num(..), Pallas, Vesta, CurvePt(..), Curve(..), Field(..), - hashToPallas, hashToVesta, pallasPrime, vestaPrime) + hashToPallas, hashToVesta, rndPallas, rndVesta, pallasPrime, vestaPrime) import Data.ByteString.UTF8 (fromString) diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -5,13 +5,13 @@ import Prelude import System.Environment (setEnv) import Test.Tasty (defaultMain, testGroup) -import TestFields (fieldProps, testBadF, testGoodF) -import TestCurves (curveProps, testHashToPallas, testHashToVesta, testPOI, testBadC, testPallasEq) +import TestFields (fieldProps, testBadF, testGoodF, testRnd) +import TestCurves (curveProps, testHashToPallas, testHashToVesta, testPOI, testBadC, testPallasEq, testRndPV) main :: IO () main = do setEnv "TASTY_QUICKCHECK_TESTS" "1_000" - defaultMain $ testGroup "\nRunning Tests" [fieldProps, testBadF, testGoodF, - testHashToPallas, testHashToVesta, curveProps, testPOI, testBadC, testPallasEq] + defaultMain $ testGroup "\nRunning Tests" [fieldProps, testBadF, testGoodF, testRnd, + testHashToPallas, testHashToVesta, curveProps, testPOI, testBadC, testPallasEq, testRndPV] print "Finished!" diff --git a/test/TestCurves.hs b/test/TestCurves.hs --- a/test/TestCurves.hs +++ b/test/TestCurves.hs @@ -3,13 +3,15 @@ {-# LANGUAGE FlexibleInstances, NoImplicitPrelude, Trustworthy #-} {-# OPTIONS_GHC -Wno-orphans #-} -module TestCurves (curveProps, testPOI, testHashToPallas, testHashToVesta, testBadC, testPallasEq) where +module TestCurves (curveProps, testPOI, testHashToPallas, testHashToVesta, + testBadC, testPallasEq, testRndPV) where import Prelude hiding (exp) import Data.ByteString (pack) import Data.ByteString.UTF8 (fromString) import Data.Maybe (fromJust, isNothing) import Data.Word (Word8) +import System.Random (mkStdGen, StdGen) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (assertBool, testCase) import Test.Tasty.QuickCheck (Arbitrary(..), testProperty) @@ -93,9 +95,9 @@ 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) + 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 @@ -120,3 +122,13 @@ y = 0x0256eafc0188b79bfa7c4b2b393893ddc298e90da500fa4a9aee17c2ea4240e6 * inv0 (z ^ (3::Integer)) expected = Projective x y 1 :: Vesta helper = actual == expected + +testRndPV :: TestTree +testRndPV = testCase "testRnd" $ + do + let (r1, f1) = rndPallas (mkStdGen 1) :: (StdGen, Pallas) + let (r2, f2) = rndPallas r1 :: (StdGen, Pallas) + assertBool "testRndP" (pointAdd f1 f2 == pointAdd f2 f1) + let (r3, f3) = rndVesta r2 :: (StdGen, Vesta) + let (_r4, f4) = rndVesta r3 :: (StdGen, Vesta) + assertBool "testRndV" (pointAdd f3 f4 == pointAdd f4 f3) diff --git a/test/TestFields.hs b/test/TestFields.hs --- a/test/TestFields.hs +++ b/test/TestFields.hs @@ -4,12 +4,13 @@ {-# OPTIONS_GHC -Wno-orphans -Wno-unrecognised-pragmas #-} {-# HLINT ignore "Redundant bracket" #-} -module TestFields (fieldProps, testBadF, testGoodF) where +module TestFields (fieldProps, testBadF, testGoodF, testRnd) where import Prelude hiding (sqrt) import Data.ByteString (pack) import Data.Maybe (fromJust, isNothing) import Data.Word (Word8) +import System.Random (mkStdGen, StdGen) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (testCase, assertBool) import Test.Tasty.QuickCheck (Arbitrary(..), choose, testProperty) @@ -61,3 +62,10 @@ assertBool "sgn0 1" (sgn0 (1 :: Fq) == 1) -- hash2Field tested as part of hash2Curve +testRnd :: TestTree +testRnd = testCase "testRnd" $ + do + let (r1, f1) = rndF (mkStdGen 1) :: (StdGen, Fp) + let (_r2, f2) = rndF r1 :: (StdGen, Fp) + assertBool "testRnd" (f1 + f2 == f2 + f1) + -- hash2Field tested as part of hash2Curve