From ea9a21f41373a8cd0ed150aed62f4190e5a17713 Mon Sep 17 00:00:00 2001 From: Eitan Chatav Date: Fri, 12 Apr 2024 13:46:02 -0700 Subject: [PATCH 01/12] cabal --- zkfold-base.cabal | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/zkfold-base.cabal b/zkfold-base.cabal index 83362df33..9d29e7d6a 100644 --- a/zkfold-base.cabal +++ b/zkfold-base.cabal @@ -151,6 +151,7 @@ library build-depends: base >= 4.9 && < 5, aeson < 2.3, + binary < 0.11, bytestring < 0.12, containers < 0.7, cryptohash-sha256 < 0.12, @@ -163,7 +164,8 @@ library semialign < 1.4, tfp < 1.1, these < 1.3, - vector < 0.14 + vector < 0.14, + vector-binary-instances < 0.3 hs-source-dirs: src test-suite zkfold-base-test From ca0f345f3589b382e72ccc6225456b27a89585ad Mon Sep 17 00:00:00 2001 From: Eitan Chatav Date: Fri, 12 Apr 2024 13:46:13 -0700 Subject: [PATCH 02/12] Update ByteString.hs --- src/ZkFold/Base/Data/ByteString.hs | 69 +++++++++--------------------- 1 file changed, 20 insertions(+), 49 deletions(-) diff --git a/src/ZkFold/Base/Data/ByteString.hs b/src/ZkFold/Base/Data/ByteString.hs index 36c2288bc..0e4537792 100644 --- a/src/ZkFold/Base/Data/ByteString.hs +++ b/src/ZkFold/Base/Data/ByteString.hs @@ -1,52 +1,23 @@ -module ZkFold.Base.Data.ByteString where - -import Data.ByteString (ByteString, cons, empty, uncons) -import Data.Map (Map, toList) -import qualified Data.Vector as V -import Data.Word (Word8) +module ZkFold.Base.Data.ByteString + ( Binary (..) + , toByteString + , fromByteString + , putWord8 + , getWord8 + ) where + +import Data.Binary +import Data.Binary.Get +import Data.Binary.Put +import qualified Data.ByteString as Strict +import qualified Data.ByteString.Lazy as Lazy import Prelude --- This module is currently used for transcripts in non-interactive proof protocols. --- TODO (Issue #19): use a serialisation library instead - -class ToByteString a where - toByteString :: a -> ByteString - -instance ToByteString ByteString where - toByteString = id - --- Little-endian encoding for unsigned integers -instance ToByteString Integer where - toByteString n - | n < 0 = error "ToByteString: Negative numbers are not supported" - | n == 0 = empty - | otherwise = - let bs = toByteString (n `div` 256) - b = fromIntegral (n `mod` 256) :: Word8 - in b `cons` bs - -instance (ToByteString a, ToByteString b) => ToByteString (a, b) where - toByteString (a, b) = toByteString a <> toByteString b - -instance ToByteString a => ToByteString [a] where - toByteString = foldMap toByteString - -instance ToByteString a => ToByteString (V.Vector a) where - toByteString = V.foldMap toByteString - -instance (ToByteString k, ToByteString a) => ToByteString (Map k a) where - toByteString = toByteString . toList - -class FromByteString a where - fromByteString :: ByteString -> Maybe a - -instance FromByteString ByteString where - fromByteString = Just +toByteString :: Binary a => a -> Strict.ByteString +toByteString = Lazy.toStrict . runPut . put -instance FromByteString Integer where - fromByteString bs - | bs == empty = Just 0 - | otherwise = do - (b, bs') <- uncons bs - let r = fromIntegral b :: Integer - (r +) . (256 *) <$> fromByteString bs' +fromByteString :: Binary a => Strict.ByteString -> Maybe a +fromByteString x = case runGetOrFail get (Lazy.fromStrict x) of + Left _ -> Nothing + Right (leftover, _, a) -> + if Lazy.null leftover then Just a else Nothing From ff1ca0779279bc322766f8208f11c2e696dd1024 Mon Sep 17 00:00:00 2001 From: Eitan Chatav Date: Fri, 12 Apr 2024 13:51:29 -0700 Subject: [PATCH 03/12] Binary instances --- examples/Examples/MiMC/Constants.hs | 2 +- src/ZkFold/Base/Algebra/Basic/Field.hs | 17 ++++++++--------- src/ZkFold/Base/Data/Sparse/Vector.hs | 9 +++++---- src/ZkFold/Base/Data/Vector.hs | 7 ++++--- .../Base/Protocol/ARK/Protostar/FiatShamir.hs | 10 +++++----- src/ZkFold/Base/Protocol/Commitment/KZG.hs | 5 +++-- src/ZkFold/Base/Protocol/NonInteractiveProof.hs | 6 +++--- 7 files changed, 29 insertions(+), 27 deletions(-) diff --git a/examples/Examples/MiMC/Constants.hs b/examples/Examples/MiMC/Constants.hs index 61b0d50f6..aa21acbbd 100644 --- a/examples/Examples/MiMC/Constants.hs +++ b/examples/Examples/MiMC/Constants.hs @@ -7,7 +7,7 @@ import Data.Maybe (fromJust) import Prelude import ZkFold.Base.Algebra.Basic.Class (FromConstant (..)) -import ZkFold.Base.Data.ByteString (FromByteString (..), ToByteString (..)) +import ZkFold.Base.Data.ByteString (Binary (..)) import ZkFold.Symbolic.Types (I) mimcSeed :: Integer diff --git a/src/ZkFold/Base/Algebra/Basic/Field.hs b/src/ZkFold/Base/Algebra/Basic/Field.hs index 8b8bd9f00..8b784d021 100644 --- a/src/ZkFold/Base/Algebra/Basic/Field.hs +++ b/src/ZkFold/Base/Algebra/Basic/Field.hs @@ -1,4 +1,5 @@ {-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} @@ -140,11 +141,7 @@ instance ToJSON (Zp p) where instance FromJSON (Zp p) where parseJSON = fmap Zp . parseJSON -instance ToByteString (Zp p) where - toByteString (Zp a) = toByteString a - -instance FromByteString (Zp p) where - fromByteString = fmap Zp . fromByteString +deriving newtype instance Binary (Zp p) instance KnownNat p => Arbitrary (Zp p) where arbitrary = toZp <$> chooseInteger (0, fromIntegral (order @(Zp p)) - 1) @@ -222,8 +219,9 @@ instance (Field f, Eq f, IrreduciblePoly f e) => Semiring (Ext2 f e) instance (Field f, Eq f, IrreduciblePoly f e) => Ring (Ext2 f e) -instance ToByteString f => ToByteString (Ext2 f e) where - toByteString (Ext2 a b) = toByteString a <> toByteString b +instance Binary f => Binary (Ext2 f e) where + put (Ext2 a b) = put a <> put b + get = Ext2 <$> get <*> get instance (Field f, Eq f, IrreduciblePoly f e, Arbitrary f) => Arbitrary (Ext2 f e) where arbitrary = Ext2 <$> arbitrary <*> arbitrary @@ -281,8 +279,9 @@ instance (Field f, Eq f, IrreduciblePoly f e) => Semiring (Ext3 f e) instance (Field f, Eq f, IrreduciblePoly f e) => Ring (Ext3 f e) -instance ToByteString f => ToByteString (Ext3 f e) where - toByteString (Ext3 a b c) = toByteString a <> toByteString b <> toByteString c +instance Binary f => Binary (Ext3 f e) where + put (Ext3 a b c) = put a <> put b <> put c + get = Ext3 <$> get <*> get <*> get instance (Field f, Eq f, IrreduciblePoly f e, Arbitrary f) => Arbitrary (Ext3 f e) where arbitrary = Ext3 <$> arbitrary <*> arbitrary <*> arbitrary diff --git a/src/ZkFold/Base/Data/Sparse/Vector.hs b/src/ZkFold/Base/Data/Sparse/Vector.hs index d6dd1ec3b..f61955410 100644 --- a/src/ZkFold/Base/Data/Sparse/Vector.hs +++ b/src/ZkFold/Base/Data/Sparse/Vector.hs @@ -1,6 +1,6 @@ module ZkFold.Base.Data.Sparse.Vector where -import Data.Map (Map, empty, filter, map) +import Data.Map (Map, empty, filter, fromList, map, toList) import Data.These (These (..)) import Data.Zip (Semialign (..), Zip (..)) import Prelude hiding (Num (..), filter, length, map, sum, zip, zipWith, (/)) @@ -9,13 +9,14 @@ import Test.QuickCheck (Arbitrary (..)) import ZkFold.Base.Algebra.Basic.Class import ZkFold.Base.Algebra.Basic.Field (Zp) import ZkFold.Base.Algebra.Basic.Number (KnownNat) -import ZkFold.Base.Data.ByteString (ToByteString (..)) +import ZkFold.Base.Data.ByteString (Binary (..)) newtype SVector size a = SVector { fromSVector :: Map (Zp size) a } deriving (Show, Eq) -instance ToByteString a => ToByteString (SVector n a) where - toByteString = toByteString . fromSVector +instance (Binary a, KnownNat n) => Binary (SVector n a) where + put = put . toList . fromSVector + get = SVector . fromList <$> get instance Foldable (SVector size) where foldr f z (SVector as) = foldr f z as diff --git a/src/ZkFold/Base/Data/Vector.hs b/src/ZkFold/Base/Data/Vector.hs index d97b99b6b..f67a6a23a 100644 --- a/src/ZkFold/Base/Data/Vector.hs +++ b/src/ZkFold/Base/Data/Vector.hs @@ -13,7 +13,7 @@ import Test.QuickCheck (Arbitrary (..)) import ZkFold.Base.Algebra.Basic.Class import ZkFold.Base.Algebra.Basic.Number -import ZkFold.Base.Data.ByteString (ToByteString (..)) +import ZkFold.Base.Data.ByteString (Binary (..)) import ZkFold.Prelude (length, replicate) newtype Vector (size :: Natural) a = Vector [a] @@ -33,8 +33,9 @@ vectorDotProduct (Vector as) (Vector bs) = sum $ zipWith (*) as bs concat :: Vector m (Vector n a) -> Vector (m * n) a concat = Vector . concatMap fromVector -instance ToByteString a => ToByteString (Vector n a) where - toByteString = toByteString . fromVector +instance Binary a => Binary (Vector n a) where + put = put . fromVector + get = Vector <$> get instance KnownNat size => Applicative (Vector size) where pure a = Vector $ replicate (value @size) a diff --git a/src/ZkFold/Base/Protocol/ARK/Protostar/FiatShamir.hs b/src/ZkFold/Base/Protocol/ARK/Protostar/FiatShamir.hs index 60af690a8..55c99ec83 100644 --- a/src/ZkFold/Base/Protocol/ARK/Protostar/FiatShamir.hs +++ b/src/ZkFold/Base/Protocol/ARK/Protostar/FiatShamir.hs @@ -6,7 +6,7 @@ module ZkFold.Base.Protocol.ARK.Protostar.FiatShamir where import Data.ByteString (ByteString) import Prelude hiding (length) -import ZkFold.Base.Data.ByteString (FromByteString, ToByteString (..)) +import ZkFold.Base.Data.ByteString (Binary (..)) import ZkFold.Base.Protocol.ARK.Protostar.CommitOpen import qualified ZkFold.Base.Protocol.ARK.Protostar.SpecialSound as SpS import ZkFold.Base.Protocol.ARK.Protostar.SpecialSound (SpecialSoundProtocol (..), SpecialSoundTranscript) @@ -14,16 +14,16 @@ import ZkFold.Base.Protocol.NonInteractiveProof (NonInteractive data FiatShamir f a = FiatShamir a (SpS.Input f a) -fsChallenge :: forall f a c . (ToByteString (SpS.Input f a), FromByteString (VerifierMessage f a), - ToByteString c, ToByteString (VerifierMessage f a)) => FiatShamir f (CommitOpen f c a) +fsChallenge :: forall f a c . (Binary (SpS.Input f a), Binary (VerifierMessage f a), + Binary c, Binary (VerifierMessage f a)) => FiatShamir f (CommitOpen f c a) -> SpecialSoundTranscript f (CommitOpen f c a) -> ProverMessage f (CommitOpen f c a) -> VerifierMessage f a fsChallenge (FiatShamir _ ip) [] c = let r0 = fst $ challenge @ByteString $ toTranscript ip :: VerifierMessage f a in fst $ challenge @ByteString $ toTranscript r0 <> toTranscript c fsChallenge _ ((_, r) : _) c = fst $ challenge @ByteString $ toTranscript r <> toTranscript c -instance (SpS.SpecialSoundProtocol f a, Eq c, ToByteString (SpS.Input f a), FromByteString (VerifierMessage f a), - ToByteString c, ToByteString (VerifierMessage f a)) => NonInteractiveProof (FiatShamir f (CommitOpen f c a)) where +instance (SpS.SpecialSoundProtocol f a, Eq c, Binary (SpS.Input f a), Binary (VerifierMessage f a), + Binary c, Binary (VerifierMessage f a)) => NonInteractiveProof (FiatShamir f (CommitOpen f c a)) where type Transcript (FiatShamir f (CommitOpen f c a)) = ByteString type Setup (FiatShamir f (CommitOpen f c a)) = FiatShamir f (CommitOpen f c a) type Witness (FiatShamir f (CommitOpen f c a)) = SpS.Witness f a diff --git a/src/ZkFold/Base/Protocol/Commitment/KZG.hs b/src/ZkFold/Base/Protocol/Commitment/KZG.hs index 31a92b448..666b7a4fe 100644 --- a/src/ZkFold/Base/Protocol/Commitment/KZG.hs +++ b/src/ZkFold/Base/Protocol/Commitment/KZG.hs @@ -9,6 +9,7 @@ import Data.ByteString (ByteString, empty) import Data.Kind (Type) import Data.Map.Strict (Map, fromList, insert, keys, toList, (!)) import qualified Data.Vector as V +import Data.Vector.Binary () import Numeric.Natural (Natural) import Prelude hiding (Num (..), length, sum, (/), (^)) import Test.QuickCheck (Arbitrary (..), chooseInt) @@ -17,7 +18,7 @@ import ZkFold.Base.Algebra.Basic.Class import ZkFold.Base.Algebra.Basic.Number import ZkFold.Base.Algebra.EllipticCurve.Class import ZkFold.Base.Algebra.Polynomials.Univariate -import ZkFold.Base.Data.ByteString (FromByteString, ToByteString) +import ZkFold.Base.Data.ByteString (Binary) import ZkFold.Base.Protocol.NonInteractiveProof -- | `d` is the degree of polynomials in the protocol @@ -35,7 +36,7 @@ instance (EllipticCurve c1, f ~ ScalarField c1, KnownNat d) => Arbitrary (Witnes -- TODO (Issue #18): check list lengths instance forall (c1 :: Type) (c2 :: Type) t f d kzg . (f ~ ScalarField c1, f ~ ScalarField c2, - Pairing c1 c2 t, ToByteString f, FromByteString f, KnownNat d, KZG c1 c2 t f d ~ kzg) + Pairing c1 c2 t, Binary f, KnownNat d, KZG c1 c2 t f d ~ kzg) => NonInteractiveProof (KZG c1 c2 t f d) where type Transcript (KZG c1 c2 t f d) = ByteString type Setup (KZG c1 c2 t f d) = (V.Vector (Point c1), Point c2, Point c2) diff --git a/src/ZkFold/Base/Protocol/NonInteractiveProof.hs b/src/ZkFold/Base/Protocol/NonInteractiveProof.hs index 2be9ec5b3..c8c964a15 100644 --- a/src/ZkFold/Base/Protocol/NonInteractiveProof.hs +++ b/src/ZkFold/Base/Protocol/NonInteractiveProof.hs @@ -9,12 +9,12 @@ import Data.Maybe (fromJust) import Numeric.Natural (Natural) import Prelude -import ZkFold.Base.Data.ByteString (FromByteString (..), ToByteString (..)) +import ZkFold.Base.Data.ByteString class Monoid t => ToTranscript t a where toTranscript :: a -> t -instance ToByteString a => ToTranscript ByteString a where +instance Binary a => ToTranscript ByteString a where toTranscript = toByteString transcript :: ToTranscript t a => t -> a -> t @@ -24,7 +24,7 @@ class Monoid t => FromTranscript t a where newTranscript :: t -> t fromTranscript :: t -> a -instance FromByteString a => FromTranscript ByteString a where +instance Binary a => FromTranscript ByteString a where newTranscript = cons 0 fromTranscript = fromJust . fromByteString . hash From 4dd0b7f7bdd2d46e9b7ee956c828f72456de0767 Mon Sep 17 00:00:00 2001 From: Eitan Chatav Date: Fri, 12 Apr 2024 13:54:19 -0700 Subject: [PATCH 04/12] Update CommitOpen.hs --- .../Base/Protocol/ARK/Protostar/CommitOpen.hs | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/src/ZkFold/Base/Protocol/ARK/Protostar/CommitOpen.hs b/src/ZkFold/Base/Protocol/ARK/Protostar/CommitOpen.hs index 28f53c30b..a3f367caa 100644 --- a/src/ZkFold/Base/Protocol/ARK/Protostar/CommitOpen.hs +++ b/src/ZkFold/Base/Protocol/ARK/Protostar/CommitOpen.hs @@ -1,19 +1,25 @@ -{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE UndecidableInstances #-} module ZkFold.Base.Protocol.ARK.Protostar.CommitOpen where import Prelude hiding (length) -import ZkFold.Base.Data.ByteString (ToByteString (..)) +import ZkFold.Base.Data.ByteString import ZkFold.Base.Protocol.ARK.Protostar.SpecialSound (SpecialSoundProtocol (..), SpecialSoundTranscript) import ZkFold.Prelude (length) data CommitOpen f c a = CommitOpen (ProverMessage f a -> c) a data CommitOpenProverMessage t c a = Commit c | Open [ProverMessage t a] -instance ToByteString c => ToByteString (CommitOpenProverMessage t c a) where - toByteString (Commit c) = toByteString c - toByteString _ = mempty +instance (Binary c, Binary (ProverMessage t a)) => Binary (CommitOpenProverMessage t c a) where + put (Commit c) = putWord8 0 <> put c + put (Open msgs) = putWord8 1 <> put msgs + get = do + flag <- getWord8 + if flag == 0 then Commit <$> get + else if flag == 1 then Open <$> get + else fail ("Binary (CommitOpenProverMessage t c a): unexpected flag " <> show flag) instance (SpecialSoundProtocol f a, Eq c) => SpecialSoundProtocol f (CommitOpen f c a) where type Witness f (CommitOpen f c a) = (Witness f a, [ProverMessage f a]) From e5478943d2f8d70300dfc62d1e8131b0876d72d7 Mon Sep 17 00:00:00 2001 From: Eitan Chatav Date: Fri, 12 Apr 2024 14:13:57 -0700 Subject: [PATCH 05/12] Binary EllipticCurve --- .../Base/Algebra/EllipticCurve/Class.hs | 19 ++++++++++++++----- 1 file changed, 14 insertions(+), 5 deletions(-) diff --git a/src/ZkFold/Base/Algebra/EllipticCurve/Class.hs b/src/ZkFold/Base/Algebra/EllipticCurve/Class.hs index b53c32243..5ecff5820 100644 --- a/src/ZkFold/Base/Algebra/EllipticCurve/Class.hs +++ b/src/ZkFold/Base/Algebra/EllipticCurve/Class.hs @@ -9,7 +9,7 @@ import qualified Prelude as Haskell import Test.QuickCheck hiding (scale) import ZkFold.Base.Algebra.Basic.Class -import ZkFold.Base.Data.ByteString (ToByteString (..)) +import ZkFold.Base.Data.ByteString type family BaseField curve @@ -17,7 +17,7 @@ type family ScalarField curve data Point curve = Point (BaseField curve) (BaseField curve) | Inf -class (FiniteField (BaseField curve), Eq (BaseField curve), Show (BaseField curve), ToByteString (BaseField curve), +class (FiniteField (BaseField curve), Eq (BaseField curve), Show (BaseField curve), Binary (BaseField curve), Haskell.Show (ScalarField curve), Haskell.Num (ScalarField curve), Haskell.Ord (ScalarField curve), PrimeField (ScalarField curve), Eq (ScalarField curve), BinaryExpansion (ScalarField curve), Arbitrary (ScalarField curve) ) => EllipticCurve curve where @@ -54,9 +54,18 @@ instance EllipticCurve curve => Scale Integer (Point curve) where instance EllipticCurve curve => AdditiveGroup (Point curve) where negate = pointNegate -instance EllipticCurve curve => ToByteString (Point curve) where - toByteString Inf = toByteString (0 :: Integer) - toByteString (Point x y) = toByteString (1 :: Integer) <> toByteString x <> toByteString y +instance EllipticCurve curve => Binary (Point curve) where + -- TODO: Point Compression + -- When we know the equation of an elliptic curve, y^2 = x^3 + a * x + b + -- then we only need to retain a flag sign byte, + -- and the x-value to reconstruct the y-value of a point. + put Inf = putWord8 0 + put (Point x y) = putWord8 1 <> put x <> put y + get = do + flag <- getWord8 + if flag == 0 then return Inf + else if flag == 1 then Point <$> get <*> get + else fail ("Binary (Point curve): unexpected flag " <> show flag) instance EllipticCurve curve => Arbitrary (Point curve) where arbitrary = arbitrary <&> (`mul` gen) From 914af49d69be2e759ec7952c97e688c607891640 Mon Sep 17 00:00:00 2001 From: Eitan Chatav Date: Fri, 12 Apr 2024 15:54:43 -0700 Subject: [PATCH 06/12] Update Constants.hs --- examples/Examples/MiMC/Constants.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/examples/Examples/MiMC/Constants.hs b/examples/Examples/MiMC/Constants.hs index aa21acbbd..5117be998 100644 --- a/examples/Examples/MiMC/Constants.hs +++ b/examples/Examples/MiMC/Constants.hs @@ -7,7 +7,7 @@ import Data.Maybe (fromJust) import Prelude import ZkFold.Base.Algebra.Basic.Class (FromConstant (..)) -import ZkFold.Base.Data.ByteString (Binary (..)) +import ZkFold.Base.Data.ByteString import ZkFold.Symbolic.Types (I) mimcSeed :: Integer From 72f46cd07826b97cb82502859819aa919a525102 Mon Sep 17 00:00:00 2001 From: Eitan Chatav Date: Fri, 12 Apr 2024 16:47:47 -0700 Subject: [PATCH 07/12] little endian --- examples/Examples/MiMC/Constants.hs | 6 ++++-- src/ZkFold/Base/Data/ByteString.hs | 22 ++++++++++++++++++++++ 2 files changed, 26 insertions(+), 2 deletions(-) diff --git a/examples/Examples/MiMC/Constants.hs b/examples/Examples/MiMC/Constants.hs index 5117be998..63ca3ad11 100644 --- a/examples/Examples/MiMC/Constants.hs +++ b/examples/Examples/MiMC/Constants.hs @@ -10,10 +10,12 @@ import ZkFold.Base.Algebra.Basic.Class (FromConstant (..)) import ZkFold.Base.Data.ByteString import ZkFold.Symbolic.Types (I) -mimcSeed :: Integer +mimcSeed :: LittleEndian mimcSeed = 42 mimcConstants :: forall a . (FromConstant I a) => [a] mimcConstants = - let cs = take 218 $ map (fromJust . fromByteString) $ iterate hash $ toByteString mimcSeed + let + getI = fromIntegral . fromJust . fromByteString @LittleEndian + cs = take 218 $ map getI $ iterate hash $ toByteString mimcSeed in map (fromConstant @I @a) (0 : cs ++ [0]) diff --git a/src/ZkFold/Base/Data/ByteString.hs b/src/ZkFold/Base/Data/ByteString.hs index 0e4537792..3b3e401f1 100644 --- a/src/ZkFold/Base/Data/ByteString.hs +++ b/src/ZkFold/Base/Data/ByteString.hs @@ -1,16 +1,22 @@ +{-# LANGUAGE DerivingStrategies #-} + module ZkFold.Base.Data.ByteString ( Binary (..) , toByteString , fromByteString , putWord8 , getWord8 + , LittleEndian (..) ) where +import Control.Applicative (many) import Data.Binary import Data.Binary.Get import Data.Binary.Put import qualified Data.ByteString as Strict import qualified Data.ByteString.Lazy as Lazy +import Data.Foldable (foldl') +import Numeric.Natural (Natural) import Prelude toByteString :: Binary a => a -> Strict.ByteString @@ -21,3 +27,19 @@ fromByteString x = case runGetOrFail get (Lazy.fromStrict x) of Left _ -> Nothing Right (leftover, _, a) -> if Lazy.null leftover then Just a else Nothing + +-- un little, deux little, trois little endians +newtype LittleEndian = LittleEndian {unLittleEndian :: Natural} + deriving stock (Read, Show) + deriving newtype (Eq, Ord, Num, Enum, Real, Integral) +instance Binary LittleEndian where + get = do + ns <- many getWord8 + let accum n w8 = n * 256 + fromIntegral w8 + littleEndian = LittleEndian (foldl' accum 0 ns) + return littleEndian + put (LittleEndian n) + | n == 0 = mempty + | otherwise = + let (n', r) = n `divMod` 256 + in putWord8 (fromIntegral r) <> put (LittleEndian n') From e8dd1c07c1fc431dea28a43657339886174a3edc Mon Sep 17 00:00:00 2001 From: Eitan Chatav Date: Fri, 12 Apr 2024 17:18:51 -0700 Subject: [PATCH 08/12] fix a CI thing? --- .github/workflows/main-pull.yml | 2 +- examples/Examples/MiMCHash.hs | 1 - 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/.github/workflows/main-pull.yml b/.github/workflows/main-pull.yml index 3bd228835..7345dfe5c 100644 --- a/.github/workflows/main-pull.yml +++ b/.github/workflows/main-pull.yml @@ -34,7 +34,7 @@ jobs: ${{ runner.os }}- - name: Install stylish-haskell - run: cabal install stylish-haskell + run: cabal install stylish-haskell --overwrite-policy=always - name: Run stylish-haskell run: | diff --git a/examples/Examples/MiMCHash.hs b/examples/Examples/MiMCHash.hs index fd6ef48d5..52d1f7075 100644 --- a/examples/Examples/MiMCHash.hs +++ b/examples/Examples/MiMCHash.hs @@ -29,4 +29,3 @@ exampleMiMC = do putStrLn "\nExample: MiMC hash function\n" compileIO @(Zp BLS12_381_Scalar) file (mimcHash @(ArithmeticCircuit (Zp BLS12_381_Scalar)) nRounds zero) - From 590e6367222a4ea33412eca5af6f511d425997cf Mon Sep 17 00:00:00 2001 From: echatav Date: Sat, 13 Apr 2024 00:22:29 +0000 Subject: [PATCH 09/12] Auto-format with stylish-haskell --- src/ZkFold/Base/Data/ByteString.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/ZkFold/Base/Data/ByteString.hs b/src/ZkFold/Base/Data/ByteString.hs index 3b3e401f1..4190e7486 100644 --- a/src/ZkFold/Base/Data/ByteString.hs +++ b/src/ZkFold/Base/Data/ByteString.hs @@ -9,14 +9,14 @@ module ZkFold.Base.Data.ByteString , LittleEndian (..) ) where -import Control.Applicative (many) +import Control.Applicative (many) import Data.Binary import Data.Binary.Get import Data.Binary.Put import qualified Data.ByteString as Strict import qualified Data.ByteString.Lazy as Lazy -import Data.Foldable (foldl') -import Numeric.Natural (Natural) +import Data.Foldable (foldl') +import Numeric.Natural (Natural) import Prelude toByteString :: Binary a => a -> Strict.ByteString From 138af9c88dc983d31e99708913ce25994f0f9d6d Mon Sep 17 00:00:00 2001 From: Eitan Chatav Date: Fri, 12 Apr 2024 17:52:26 -0700 Subject: [PATCH 10/12] comment --- src/ZkFold/Base/Data/ByteString.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/ZkFold/Base/Data/ByteString.hs b/src/ZkFold/Base/Data/ByteString.hs index 4190e7486..535977b1d 100644 --- a/src/ZkFold/Base/Data/ByteString.hs +++ b/src/ZkFold/Base/Data/ByteString.hs @@ -28,6 +28,7 @@ fromByteString x = case runGetOrFail get (Lazy.fromStrict x) of Right (leftover, _, a) -> if Lazy.null leftover then Just a else Nothing +-- Little-endian encoding for unsigned integers -- un little, deux little, trois little endians newtype LittleEndian = LittleEndian {unLittleEndian :: Natural} deriving stock (Read, Show) From 7c5f53ff4ecf2861b576636f4b32f6726b3da4d3 Mon Sep 17 00:00:00 2001 From: Eitan Chatav Date: Fri, 12 Apr 2024 17:53:12 -0700 Subject: [PATCH 11/12] comment --- src/ZkFold/Base/Data/ByteString.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/ZkFold/Base/Data/ByteString.hs b/src/ZkFold/Base/Data/ByteString.hs index 535977b1d..23e86d64f 100644 --- a/src/ZkFold/Base/Data/ByteString.hs +++ b/src/ZkFold/Base/Data/ByteString.hs @@ -28,7 +28,7 @@ fromByteString x = case runGetOrFail get (Lazy.fromStrict x) of Right (leftover, _, a) -> if Lazy.null leftover then Just a else Nothing --- Little-endian encoding for unsigned integers +-- Little-endian encoding for unsigned & unsized integers -- un little, deux little, trois little endians newtype LittleEndian = LittleEndian {unLittleEndian :: Natural} deriving stock (Read, Show) From ceeb49a6e3f801e023166e3867f5889551434622 Mon Sep 17 00:00:00 2001 From: Eitan Chatav Date: Fri, 12 Apr 2024 18:41:53 -0700 Subject: [PATCH 12/12] redundant constraints --- src/ZkFold/Base/Protocol/ARK/Protostar/FiatShamir.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/ZkFold/Base/Protocol/ARK/Protostar/FiatShamir.hs b/src/ZkFold/Base/Protocol/ARK/Protostar/FiatShamir.hs index 55c99ec83..cddcd88dc 100644 --- a/src/ZkFold/Base/Protocol/ARK/Protostar/FiatShamir.hs +++ b/src/ZkFold/Base/Protocol/ARK/Protostar/FiatShamir.hs @@ -14,8 +14,8 @@ import ZkFold.Base.Protocol.NonInteractiveProof (NonInteractive data FiatShamir f a = FiatShamir a (SpS.Input f a) -fsChallenge :: forall f a c . (Binary (SpS.Input f a), Binary (VerifierMessage f a), - Binary c, Binary (VerifierMessage f a)) => FiatShamir f (CommitOpen f c a) +fsChallenge :: forall f a c . (Binary (SpS.Input f a), Binary (VerifierMessage f a)) + => FiatShamir f (CommitOpen f c a) -> SpecialSoundTranscript f (CommitOpen f c a) -> ProverMessage f (CommitOpen f c a) -> VerifierMessage f a fsChallenge (FiatShamir _ ip) [] c = let r0 = fst $ challenge @ByteString $ toTranscript ip :: VerifierMessage f a