From 41b2f6035792e6b96c4d95d1b87230b804168965 Mon Sep 17 00:00:00 2001 From: Balazs Komuves Date: Tue, 14 Oct 2025 20:21:19 +0200 Subject: [PATCH] incorporate C monolith hash implementation (TODO: fast hashing of flat arrays of field elements) --- reference/README.md | 13 +++ reference/src/Field/Goldilocks/Extension.hs | 14 +++ reference/src/Field/Goldilocks/Fast.hs | 8 ++ reference/src/Hash/Common.hs | 20 ---- reference/src/Hash/Duplex/Monad.hs | 2 + reference/src/Hash/Duplex/Pure.hs | 7 +- reference/src/Hash/Merkle.hs | 5 +- reference/src/Hash/Monolith/Permutation.hs | 2 + reference/src/Hash/Permutations.hs | 36 ++++++++ reference/src/Hash/Sponge.hs | 7 +- reference/src/Hash/State.hs | 14 +++ reference/src/Hash/State/FastC.hs | 97 ++++++++++++++++++++ reference/src/Hash/State/Naive.hs | 49 ++++++++++ reference/src/cbits/monolith.c | 6 ++ reference/src/cbits/monolith.h | 11 ++- reference/src/cbits/monolith.o | Bin 9648 -> 9784 bytes reference/src/runi.sh | 3 + 17 files changed, 259 insertions(+), 35 deletions(-) create mode 100644 reference/src/Hash/State.hs create mode 100644 reference/src/Hash/State/FastC.hs create mode 100644 reference/src/Hash/State/Naive.hs create mode 100755 reference/src/runi.sh diff --git a/reference/README.md b/reference/README.md index 1b3e7b8..aa470a6 100644 --- a/reference/README.md +++ b/reference/README.md @@ -16,6 +16,19 @@ We could significantly improve the speed of the Haskell implementation by bindin for some of the critical routines: Goldilocks field and extension, hashing, fast Fourier transform. +### Implementation status + +- [x] FRI prover +- [x] FRI verifier +- [ ] proof serialization +- [ ] serious testing of the FRI verifier +- [ ] full outsourcing protocol +- [ ] command line interface +- [x] faster Goldilocks field operations via C FFI +- [ ] quadratic field extension in C too +- [ ] faster hashing via C FFI +- [ ] faster NTT via C FFI + ### References - E. Ben-Sasson, L. Goldberg, S. Kopparty, and S. Saraf: _"DEEP-FRI: Sampling outside the box improves soundness"_ - https://eprint.iacr.org/2019/336 diff --git a/reference/src/Field/Goldilocks/Extension.hs b/reference/src/Field/Goldilocks/Extension.hs index df35659..73ea096 100644 --- a/reference/src/Field/Goldilocks/Extension.hs +++ b/reference/src/Field/Goldilocks/Extension.hs @@ -14,6 +14,9 @@ import Data.Ratio import System.Random +import Foreign.Ptr +import Foreign.Storable + import Data.Binary import Field.Goldilocks ( F ) @@ -57,6 +60,17 @@ instance Random F2 where in (F2 x y, g'') randomR = error "randomR/F2: doesn't make any sense" +instance Storable F2 where + peek ptr = do + r <- peek (castPtr ptr) + i <- peek (castPtr ptr `plusPtr` 8) + return (F2 r i) + poke ptr (F2 r i) = do + poke (castPtr ptr) r + poke (castPtr ptr `plusPtr` 8) i + sizeOf _ = 16 + alignment _ = 8 + -------------------------------------------------------------------------------- zero, one, two :: F2 diff --git a/reference/src/Field/Goldilocks/Fast.hs b/reference/src/Field/Goldilocks/Fast.hs index ddeefac..09b0e1e 100644 --- a/reference/src/Field/Goldilocks/Fast.hs +++ b/reference/src/Field/Goldilocks/Fast.hs @@ -14,6 +14,8 @@ import Data.Word import Data.Ratio import Foreign.C +import Foreign.Ptr +import Foreign.Storable import System.Random @@ -43,6 +45,12 @@ instance Binary F where put x = putWord64le (fromF x) get = toF <$> getWord64le +instance Storable F where + peek ptr = MkGoldilocks <$> peek (castPtr ptr) + poke ptr (MkGoldilocks x) = poke (castPtr ptr) x + sizeOf _ = 8 + alignment _ = 8 + -------------------------------------------------------------------------------- newtype Goldilocks diff --git a/reference/src/Hash/Common.hs b/reference/src/Hash/Common.hs index 1efde76..7a99260 100644 --- a/reference/src/Hash/Common.hs +++ b/reference/src/Hash/Common.hs @@ -34,22 +34,6 @@ hashRate hash = case hash of -------------------------------------------------------------------------------- -type State = Array Int F - -listToState' :: Int -> [F] -> State -listToState' n = listArray (0,n-1) - -listToState :: Hash -> [F] -> State -listToState hash = listToState' (hashT hash) - -zeroState' :: Int -> State -zeroState' n = listToState' n (replicate n 0) - -zeroState :: Hash -> State -zeroState hash = zeroState' (hashT hash) - --------------------------------------------------------------------------------- - data Digest = MkDigest !F !F !F !F deriving (Eq,Show) @@ -64,10 +48,6 @@ instance FieldEncode Digest where zeroDigest :: Digest zeroDigest = MkDigest 0 0 0 0 -extractDigest :: State -> Digest -extractDigest state = case elems state of - (a:b:c:d:_) -> MkDigest a b c d - listToDigest :: [F] -> Digest listToDigest [a,b,c,d] = MkDigest a b c d diff --git a/reference/src/Hash/Duplex/Monad.hs b/reference/src/Hash/Duplex/Monad.hs index f72e2e4..b607cd4 100644 --- a/reference/src/Hash/Duplex/Monad.hs +++ b/reference/src/Hash/Duplex/Monad.hs @@ -16,7 +16,9 @@ import Control.Monad.IO.Class import Text.Show.Pretty import Field.Goldilocks + import Hash.Common +import Hash.State import Hash.Duplex.Pure ( DuplexState, Squeeze, Absorb , theHashFunction ) import qualified Hash.Duplex.Pure as Pure diff --git a/reference/src/Hash/Duplex/Pure.hs b/reference/src/Hash/Duplex/Pure.hs index c8535a0..71ea848 100644 --- a/reference/src/Hash/Duplex/Pure.hs +++ b/reference/src/Hash/Duplex/Pure.hs @@ -18,7 +18,9 @@ import Data.Array import Field.Goldilocks ( F ) import Field.Goldilocks.Extension ( FExt , F2(..) ) + import Hash.Permutations +import Hash.State import Hash.Common -------------------------------------------------------------------------------- @@ -37,14 +39,11 @@ data DuplexState duplexInitialState :: State -> DuplexState duplexInitialState state = Absorbing state [] -overwrite :: [F] -> State -> State -overwrite new old = listToState theHashFunction $ new ++ drop (length new) (elems old) - duplex :: [F] -> State -> State duplex inp old = permute theHashFunction (overwrite inp old) extract :: State -> [F] -extract state = reverse $ take rate (elems state) where +extract state = reverse $ take rate (stateToList state) where rate = 8 freshSqueezing :: State -> DuplexState diff --git a/reference/src/Hash/Merkle.hs b/reference/src/Hash/Merkle.hs index 57161b0..746da72 100644 --- a/reference/src/Hash/Merkle.hs +++ b/reference/src/Hash/Merkle.hs @@ -33,6 +33,7 @@ import Field.Encode import Hash.Permutations import Hash.Common +import Hash.State import Hash.Sponge import Misc @@ -262,13 +263,13 @@ reconstructMerkleRoot (MkMerkleProof idx leaf (MkRawMerklePath path) size) = dig compress :: Hash -> Digest -> Digest -> Digest compress which (MkDigest a b c d) (MkDigest p q r s) = extractDigest output where - input = listArray (0,11) [ a,b,c,d , p,q,r,s , 0,0,0,0 ] + input = listToState' 12 [ a,b,c,d , p,q,r,s , 0,0,0,0 ] output = permute which input keyedCompress :: Hash -> Key -> Digest -> Digest -> Digest keyedCompress which key (MkDigest a b c d) (MkDigest p q r s) = extractDigest output where k = fromIntegral key :: F - input = listArray (0,11) [ a,b,c,d , p,q,r,s , k,0,0,0 ] + input = listToState' 12 [ a,b,c,d , p,q,r,s , k,0,0,0 ] output = permute which input -------------------------------------------------------------------------------- diff --git a/reference/src/Hash/Monolith/Permutation.hs b/reference/src/Hash/Monolith/Permutation.hs index 60da24a..78eaad6 100644 --- a/reference/src/Hash/Monolith/Permutation.hs +++ b/reference/src/Hash/Monolith/Permutation.hs @@ -12,6 +12,8 @@ import Data.Bits import Data.Word import Field.Goldilocks + +import Hash.State.Naive import Hash.Monolith.Constants import Hash.Common diff --git a/reference/src/Hash/Permutations.hs b/reference/src/Hash/Permutations.hs index 6fe3148..93a3c12 100644 --- a/reference/src/Hash/Permutations.hs +++ b/reference/src/Hash/Permutations.hs @@ -1,16 +1,52 @@ +{-# LANGUAGE CPP, ForeignFunctionInterface #-} module Hash.Permutations where -------------------------------------------------------------------------------- +import Data.Word + +import Foreign.Ptr +import Foreign.ForeignPtr + +import System.IO.Unsafe + import qualified Hash.Monolith.Permutation as Monolith import Hash.Common +import Hash.State -------------------------------------------------------------------------------- +#ifdef USE_NAIVE_HASKELL + permute :: Hash -> State -> State permute hash = case hash of Monolith -> Monolith.permutation -------------------------------------------------------------------------------- + +#else + +foreign import ccall unsafe "goldilocks_monolith_permutation" c_monolith_permutation :: Ptr Word64 -> IO () +foreign import ccall unsafe "goldilocks_monolith_permutation_into" c_monolith_permutation_into :: Ptr Word64 -> Ptr Word64 -> IO () + +permuteInPlace :: State -> IO () +permuteInPlace fptr = withForeignPtr fptr $ \ptr -> c_monolith_permutation (castPtr ptr) + +{-# NOINLINE permuteIO #-} +permuteIO :: State -> IO State +permuteIO src = do + tgt <- mallocForeignPtrArray 12 + withForeignPtr src $ \ptr1 -> + withForeignPtr tgt $ \ptr2 -> + c_monolith_permutation_into (castPtr ptr1) (castPtr ptr2) + return tgt + +permute :: Hash -> State -> State +permute _ what = unsafePerformIO (permuteIO what) + +-------------------------------------------------------------------------------- + +#endif + diff --git a/reference/src/Hash/Sponge.hs b/reference/src/Hash/Sponge.hs index 24fc7f8..fc575ef 100644 --- a/reference/src/Hash/Sponge.hs +++ b/reference/src/Hash/Sponge.hs @@ -31,7 +31,9 @@ import Data.Word import Data.List import Field.Goldilocks + import Hash.Permutations +import Hash.State import Hash.Common -------------------------------------------------------------------------------- @@ -69,7 +71,7 @@ hashFieldElems' which rate@(Rate r) fels -- internalSponge :: Hash -> Int -> Rate -> [[F]] -> Digest internalSponge which nbits (Rate r) blocks = extractDigest (loop blocks iv) where - iv = listArray (0,11) $ [ 0,0,0,0 , 0,0,0,0 , domSep,0,0,0 ] :: State + iv = listToState' 12 $ [ 0,0,0,0 , 0,0,0,0 , domSep,0,0,0 ] :: State domSep = fromIntegral (65536*nbits + 256*t + r) :: F t = 12 @@ -81,9 +83,6 @@ internalSponge which nbits (Rate r) blocks = extractDigest (loop blocks iv) wher (this:rest) -> loop rest (step this state) [] -> state -addToState :: [F] -> State -> State -addToState xs arr = listArray (0,11) $ zipWith (+) (xs ++ repeat 0) (elems arr) - -------------------------------------------------------------------------------- hashBytes :: Hash -> [Word8] -> Digest diff --git a/reference/src/Hash/State.hs b/reference/src/Hash/State.hs new file mode 100644 index 0000000..52db277 --- /dev/null +++ b/reference/src/Hash/State.hs @@ -0,0 +1,14 @@ + +{-# LANGUAGE CPP #-} + +#ifdef USE_NAIVE_HASKELL + +module Hash.State ( module Hash.State.Naive ) where +import Hash.State.Naive + +#else + +module Hash.State ( module Hash.State.FastC ) where +import Hash.State.FastC + +#endif diff --git a/reference/src/Hash/State/FastC.hs b/reference/src/Hash/State/FastC.hs new file mode 100644 index 0000000..548cbf5 --- /dev/null +++ b/reference/src/Hash/State/FastC.hs @@ -0,0 +1,97 @@ + +module Hash.State.FastC where + +-------------------------------------------------------------------------------- + +import Data.Bits +import Data.Word + +import Control.Monad +import System.IO.Unsafe + +import Foreign.C +import Foreign.Ptr +import Foreign.ForeignPtr +import Foreign.Marshal +import Foreign.Storable + +import Field.Goldilocks + +import Hash.Common + +-------------------------------------------------------------------------------- + +type State = ForeignPtr F + +{-# NOINLINE listToStateIO #-} +listToStateIO :: Int -> [F] -> IO State +listToStateIO n xs = do + fptr <- mallocForeignPtrArray n :: IO (ForeignPtr F) + withForeignPtr fptr $ \ptr -> pokeArray ptr xs + return fptr + +listToState' :: Int -> [F] -> State +listToState' n xs = unsafePerformIO (listToStateIO n xs) + +listToState :: Hash -> [F] -> State +listToState hash = listToState' (hashT hash) + +zeroState' :: Int -> State +zeroState' n = listToState' n (replicate n 0) + +zeroState :: Hash -> State +zeroState hash = zeroState' (hashT hash) + +-------------------------------------------------------------------------------- + +{-# NOINLINE stateToListIO #-} +stateToListIO :: State -> IO [F] +stateToListIO fptr = do + withForeignPtr fptr $ \ptr -> do + peekArray 12 ptr + +stateToList :: State -> [F] +stateToList state = unsafePerformIO (stateToListIO state) + +{-# NOINLINE extractDigestIO #-} +extractDigestIO :: State -> IO Digest +extractDigestIO fptr = + withForeignPtr fptr $ \ptr -> do + a <- peek (ptr ) + b <- peek (ptr `plusPtr` 8) + c <- peek (ptr `plusPtr` 16) + d <- peek (ptr `plusPtr` 24) + return (MkDigest a b c d) + +extractDigest :: State -> Digest +extractDigest state = unsafePerformIO (extractDigestIO state) + +{-# NOINLINE overwriteIO #-} +overwriteIO :: [F] -> State -> IO State +overwriteIO xs src = do + tgt <- mallocForeignPtrArray 12 + withForeignPtr src $ \ptr1 -> do + withForeignPtr tgt $ \ptr2 -> do + copyArray ptr2 ptr1 12 + pokeArray ptr2 xs + return tgt + +overwrite :: [F] -> State -> State +overwrite new old = unsafePerformIO (overwriteIO new old) + +{-# NOINLINE addToStateIO #-} +addToStateIO :: [F] -> State -> IO State +addToStateIO xs src = do + tgt <- mallocForeignPtrArray 12 + withForeignPtr src $ \ptr1 -> do + withForeignPtr tgt $ \ptr2 -> do + copyArray ptr2 ptr1 12 + forM_ (zip [0..] xs) $ \(i,x) -> do + a <- peekElemOff ptr1 i + pokeElemOff ptr2 i (a + x) + return tgt + +addToState :: [F] -> State -> State +addToState new old = unsafePerformIO (addToStateIO new old) + +-------------------------------------------------------------------------------- diff --git a/reference/src/Hash/State/Naive.hs b/reference/src/Hash/State/Naive.hs new file mode 100644 index 0000000..2a0a2f4 --- /dev/null +++ b/reference/src/Hash/State/Naive.hs @@ -0,0 +1,49 @@ + +module Hash.State.Naive where + +-------------------------------------------------------------------------------- + +import Data.Array +import Data.Bits +import Data.Word + +import Data.Binary + +import Field.Goldilocks +import Field.Encode + +import Hash.Common + +-------------------------------------------------------------------------------- + +type State = Array Int F + +listToState' :: Int -> [F] -> State +listToState' n = listArray (0,n-1) + +listToState :: Hash -> [F] -> State +listToState hash = listToState' (hashT hash) + +zeroState' :: Int -> State +zeroState' n = listToState' n (replicate n 0) + +zeroState :: Hash -> State +zeroState hash = zeroState' (hashT hash) + +-------------------------------------------------------------------------------- + +stateToList :: State -> [F] +stateToList = elems + +extractDigest :: State -> Digest +extractDigest state = case elems state of + (a:b:c:d:_) -> MkDigest a b c d + +overwrite :: [F] -> State -> State +overwrite new old = listToState' 12 $ new ++ drop (length new) (elems old) + +addToState :: [F] -> State -> State +addToState xs arr = listArray (0,11) $ zipWith (+) (xs ++ repeat 0) (elems arr) + +-------------------------------------------------------------------------------- + diff --git a/reference/src/cbits/monolith.c b/reference/src/cbits/monolith.c index 808520e..ba61173 100644 --- a/reference/src/cbits/monolith.c +++ b/reference/src/cbits/monolith.c @@ -1,5 +1,6 @@ #include +#include #include "goldilocks.h" #include "monolith.h" @@ -141,6 +142,11 @@ void goldilocks_monolith_permutation(uint64_t *state) { goldilocks_monolith_concrete(state); } +void goldilocks_monolith_permutation_into(uint64_t *src, uint64_t *tgt) { + memcpy( tgt , src , 12*8 ); + goldilocks_monolith_permutation( tgt ); +} + //------------------------------------------------------------------------------ // compression function: input is two 4-element vector of field elements, diff --git a/reference/src/cbits/monolith.h b/reference/src/cbits/monolith.h index d8d905e..67cfc33 100644 --- a/reference/src/cbits/monolith.h +++ b/reference/src/cbits/monolith.h @@ -3,10 +3,11 @@ //------------------------------------------------------------------------------ -void goldilocks_monolith_permutation (uint64_t *state); -void goldilocks_monolith_keyed_compress(const uint64_t *x, const uint64_t *y, uint64_t key, uint64_t *out); -void goldilocks_monolith_compress (const uint64_t *x, const uint64_t *y, uint64_t *out); -void goldilocks_monolith_bytes_digest (int rate, int N, const uint8_t *input, uint64_t *hash); -void goldilocks_monolith_felts_digest (int rate, int N, const uint64_t *input, uint64_t *hash); +void goldilocks_monolith_permutation (uint64_t *state); +void goldilocks_monolith_permutation_into(uint64_t *src, uint64_t *tgt); +void goldilocks_monolith_keyed_compress (const uint64_t *x, const uint64_t *y, uint64_t key, uint64_t *out); +void goldilocks_monolith_compress (const uint64_t *x, const uint64_t *y, uint64_t *out); +void goldilocks_monolith_bytes_digest (int rate, int N, const uint8_t *input, uint64_t *hash); +void goldilocks_monolith_felts_digest (int rate, int N, const uint64_t *input, uint64_t *hash); //------------------------------------------------------------------------------ diff --git a/reference/src/cbits/monolith.o b/reference/src/cbits/monolith.o index 9603d741f332fa786b649be480ff0a6b974e9c5d..ec72cdbc29edc2a2f0ec1487f885fc209b6aac1a 100644 GIT binary patch delta 1902 zcmZ9NUuauZ9LIn6=GrbAyZ%X+zgup)o3_e=1q*i2*mmqeFhbp4_Rxz}A~=j&l?*nm zq{9kBDrB5I++ol#A_Q5Wl0J0MhX_SPh3%maWmN6M9(>qC!9DaLh~Hn%FIe`2b3f<% z`>GN(L6FF& z2F#c`X4nHB6x$aX^iZ8OW=`6}TJFmdmqM5W*WxLnkeUk(sk&jG4JU|7@bVz8sSf=T zI5mQYMf3tNkH*G*ZYR)^O~d>q5GQN4VO!K7Yp!7i&NW5?CbZGm_ZdGly*{hQ966!B z4UU@UqRpR!pIU~El|%m308+rNtD8{mqsl0#8mbJ~Ajjh%=Lu`NPw>iEApJLp z@0{KQIliIk*1#buQo4i=C;9;71-AOMt_jzK1>u75yzq=LC~Uu|3-mx?{Ki2E^lQ3@_>eqd7vw}cn(j8p<16C##J?hb)rzh9aXhmv9IudiD?Zjy z%N_N3JXGYQlTe&=Leq7?G5FihYwif|30H*+!bxF3_}H)KZ3)Z5yzmV$g8b8d>^XN< zj_CrHHQhy!3!4@HwD>1LE-WZK#3^OHCu|98!dt?;a9%hm4EGjwf;Nux7!o}Oxu9KP z9ORt|Yr4xgJ>!Tk33I|r!mMysI4K+##)bVt>$r4UX6Iz~sPL&ji#w6s$X>+qd67z_ z3jQ8_7~P3lzEZRt^}uq>i&bKlZzHjp*h*lWU9qdS<*PgQoOP$yY&$EdUh}DQi2f7j z0MA;g4o@Xj#j~99QcrzEeOS6{ceS>1_`%_u5d9{OHFm&e(E8x(UWlJzGVA+tLEho< zXxpN{mhpdy{z~E`SEpi)ckW)lA4;6_0wleHjirqWQhh=%oy7$_7q+o5~ z`><6-=WsySPNH$V(8-BgO6GTO$v;F_aN^nSiq7HZ!*)&QQ{UOiVz<-@RK_`LAls;{ z89=pcA4|N1F>Dt^|04Py8Q=M1K>U&D36Sk4(RtB44eP0yr2p+X$+atMKR{5@cIE~# z=cs<~8O=2ujhED&WMc5&XS@Ml^Vj5$hPvnk`P3>hd)7r_Z6 zI9YU|5V;j97W@}M!9}G7J5V(4x^RXrTx3y(F2vO^xX2MB8jez>d(Te~t}w7?nS`AIrF^>AKBBv< zSZ@wW>`w!=rq5Xyj;cW;t6btNmh{0D9#(2dUk~-`7gp@tHdGm2NeZLQx=Nh@Ya?h# zKZNlNnwX5GN#WSKWj_o)+v@JHZw%_U1IO*#&idzpTYf92pM*kz-5`=+EoG(kUyd8t z=`p@V{oV;#7xh=iwX)I|%6Pt*Qt>6QQ>j$RFj)ls(0RjT4(xzlG)&$EW!@Zk0RC%+ z$yre5r45raARZ=_GE7c^c;a{h#Df;%K@3Kf%61uM{_9n$9|<+k1Gm62@G*D{tQ=ri7co{ijC#koo|7L#cx<`D2dIA)CNS&pYX;@D`8VOuI!dmiQ qLF^@hEZfrm@6!p?_%Z%;U;J17b;Rwf?el)N*MA;;ZLM408T%W>nBSTJ diff --git a/reference/src/runi.sh b/reference/src/runi.sh new file mode 100755 index 0000000..f1fc46f --- /dev/null +++ b/reference/src/runi.sh @@ -0,0 +1,3 @@ +#!/bin/bash + +ghci testMain.hs cbits/goldilocks.o cbits/monolith.o \ No newline at end of file