mirror of
https://github.com/logos-storage/logos-storage-proofs-circuits.git
synced 2026-05-18 09:59:26 +00:00
add the option of using the "new" round constants in Poseidon2 reference implementation (the Haskell one)
This commit is contained in:
Balazs Komuves
parent
82de35640d
commit
84b23e7ba7
@ -3,6 +3,7 @@ module Main where
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
import Poseidon2 ( Flavour(..) )
|
||||
import Slot ( SlotIdx(..) , DataSource(..) , Seed(..) )
|
||||
import DataSet
|
||||
import Sampling
|
||||
@ -19,6 +20,7 @@ smallDataSetCfg = MkDataSetCfg
|
||||
, _nCells = 256 -- 64
|
||||
, _nSamples = 10
|
||||
, _dataSrc = FakeData (Seed 12345)
|
||||
, _hashFlavour = HorizenLabsOld
|
||||
}
|
||||
|
||||
bigDataSetCfg :: DataSetCfg
|
||||
@ -31,6 +33,7 @@ bigDataSetCfg = MkDataSetCfg
|
||||
, _nCells = 512
|
||||
, _nSamples = 5
|
||||
, _dataSrc = FakeData (Seed 666)
|
||||
, _hashFlavour = HorizenLabsOld
|
||||
}
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
@ -10,19 +10,21 @@ import System.FilePath
|
||||
import Slot hiding ( MkSlotCfg(..) )
|
||||
import qualified Slot as Slot
|
||||
|
||||
import Poseidon2 ( Flavour(..) )
|
||||
import Misc
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
data DataSetCfg = MkDataSetCfg
|
||||
{ _maxDepth :: Int -- ^ @nCells@ must fit into this many bits
|
||||
, _maxLog2NSlots :: Int -- ^ @nSlots@ must fit into this many bits
|
||||
, _nSlots :: Int -- ^ number of slots per dataset
|
||||
, _cellSize :: Int -- ^ cell size in bytes
|
||||
, _blockSize :: Int -- ^ slot size in bytes
|
||||
, _nCells :: Int -- ^ number of cells per slot
|
||||
, _nSamples :: Int -- ^ number of cells we sample in a proof
|
||||
, _dataSrc :: DataSource
|
||||
{ _maxDepth :: Int -- ^ @nCells@ must fit into this many bits
|
||||
, _maxLog2NSlots :: Int -- ^ @nSlots@ must fit into this many bits
|
||||
, _nSlots :: Int -- ^ number of slots per dataset
|
||||
, _cellSize :: Int -- ^ cell size in bytes
|
||||
, _blockSize :: Int -- ^ slot size in bytes
|
||||
, _nCells :: Int -- ^ number of cells per slot
|
||||
, _nSamples :: Int -- ^ number of cells we sample in a proof
|
||||
, _hashFlavour :: Flavour
|
||||
, _dataSrc :: DataSource
|
||||
}
|
||||
deriving Show
|
||||
|
||||
@ -31,11 +33,12 @@ fieldElemsPerCell cfg = (DataSet._cellSize cfg + 30) `div` 31
|
||||
|
||||
dataSetSlotCfg :: DataSetCfg -> SlotIdx -> SlotConfig
|
||||
dataSetSlotCfg dsetCfg idx = Slot.MkSlotCfg
|
||||
{ Slot._cellSize = DataSet._cellSize dsetCfg
|
||||
, Slot._blockSize = DataSet._blockSize dsetCfg
|
||||
, Slot._nCells = DataSet._nCells dsetCfg
|
||||
, Slot._nSamples = DataSet._nSamples dsetCfg
|
||||
, Slot._dataSrc = parametricSlotDataSource (DataSet._dataSrc dsetCfg) idx
|
||||
{ Slot._cellSize = DataSet._cellSize dsetCfg
|
||||
, Slot._blockSize = DataSet._blockSize dsetCfg
|
||||
, Slot._nCells = DataSet._nCells dsetCfg
|
||||
, Slot._nSamples = DataSet._nSamples dsetCfg
|
||||
, Slot._hashFlavour = DataSet._hashFlavour dsetCfg
|
||||
, Slot._dataSrc = parametricSlotDataSource (DataSet._dataSrc dsetCfg) idx
|
||||
}
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
@ -3,6 +3,7 @@
|
||||
|
||||
module Poseidon2
|
||||
( Fr
|
||||
, Flavour(..)
|
||||
, sponge1 , sponge2
|
||||
, calcMerkleRoot , calcMerkleTree
|
||||
, MerkleTree(..) , depthOf , merkleRootOf , treeBottomLayer
|
||||
|
||||
@ -10,15 +10,25 @@ import Poseidon2.Permutation
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
-- BN254 example test vector
|
||||
exInput, exOutput :: (Fr,Fr,Fr)
|
||||
exInput, exOutputOld, exOutputNew :: (Fr,Fr,Fr)
|
||||
exInput = (0,1,2)
|
||||
exOutput =
|
||||
|
||||
exOutputOld =
|
||||
( 0x30610a447b7dec194697fb50786aa7421494bd64c221ba4d3b1af25fb07bd103
|
||||
, 0x13f731d6ffbad391be22d2ac364151849e19fa38eced4e761bcd21dbdc600288
|
||||
, 0x1433e2c8f68382c447c5c14b8b3df7cbfd9273dd655fe52f1357c27150da786f
|
||||
)
|
||||
|
||||
kats :: Bool
|
||||
kats = permutation exInput == exOutput
|
||||
exOutputNew =
|
||||
( 0x0bb61d24daca55eebcb1929a82650f328134334da98ea4f847f760054f4a3033
|
||||
, 0x303b6f7c86d043bfcbcc80214f26a30277a15d3f74ca654992defe7ff8d03570
|
||||
, 0x1ed25194542b12eef8617361c3ba7c52e660b145994427cc86296242cf766ec8
|
||||
)
|
||||
|
||||
katsOld :: Bool
|
||||
katsOld = permutation HorizenLabsOld exInput == exOutputOld
|
||||
|
||||
katsNew :: Bool
|
||||
katsNew = permutation HorizenLabsNew exInput == exOutputNew
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
@ -33,12 +33,12 @@ import Poseidon2.Permutation
|
||||
--
|
||||
-- Note the first layer is the bottom (widest) layer, and the last layer is the top (root).
|
||||
--
|
||||
newtype MerkleTree
|
||||
= MkMerkleTree (Array Int (Array Int Fr))
|
||||
data MerkleTree
|
||||
= MkMerkleTree !Flavour !(Array Int (Array Int Fr))
|
||||
deriving Show
|
||||
|
||||
merkleRootOf :: MerkleTree -> Fr
|
||||
merkleRootOf (MkMerkleTree outer)
|
||||
merkleRootOf (MkMerkleTree flavour outer)
|
||||
| c == d = inner ! c
|
||||
| otherwise = error "merkleRootOf: topmost layer is not singleton"
|
||||
where
|
||||
@ -51,11 +51,11 @@ merkleRootOf (MkMerkleTree outer)
|
||||
-- NOTE: this is one less than the actual number of layers!
|
||||
--
|
||||
depthOf :: MerkleTree -> Int
|
||||
depthOf (MkMerkleTree outer) = b-a where
|
||||
depthOf (MkMerkleTree flavour outer) = b-a where
|
||||
(a,b) = bounds outer
|
||||
|
||||
treeBottomLayer :: MerkleTree -> [Fr]
|
||||
treeBottomLayer (MkMerkleTree arr) = elems (arr!0)
|
||||
treeBottomLayer (MkMerkleTree flavour arr) = elems (arr!0)
|
||||
|
||||
{-
|
||||
calcMerkleTree' :: [Fr] -> [[Fr]]
|
||||
@ -66,29 +66,30 @@ calcMerkleTree' = go where
|
||||
go xs = xs : go (map compressPair $ pairs xs)
|
||||
-}
|
||||
|
||||
calcMerkleTree' :: [Fr] -> [[Fr]]
|
||||
calcMerkleTree' input =
|
||||
calcMerkleTree' :: Flavour -> [Fr] -> [[Fr]]
|
||||
calcMerkleTree' flavour input =
|
||||
case input of
|
||||
[] -> error "calcMerkleTree': input is empty"
|
||||
[z] -> [[keyedCompression (nodeKey BottomLayer OddNode) z 0]]
|
||||
[z] -> [[keyedCompression flavour (nodeKey BottomLayer OddNode) z 0]]
|
||||
zs -> go layerFlags zs
|
||||
where
|
||||
go :: [LayerFlag] -> [Fr] -> [[Fr]]
|
||||
go _ [x] = [[x]]
|
||||
go (f:fs) xs = xs : go fs (map (evenOddCompressPair f) $ eiPairs xs)
|
||||
go (f:fs) xs = xs : go fs (map (evenOddCompressPair flavour f) $ eiPairs xs)
|
||||
|
||||
calcMerkleTree :: [Fr] -> MerkleTree
|
||||
calcMerkleTree = MkMerkleTree . go1 . calcMerkleTree' where
|
||||
calcMerkleTree :: Flavour -> [Fr] -> MerkleTree
|
||||
calcMerkleTree flavour = MkMerkleTree flavour . go1 . calcMerkleTree' flavour where
|
||||
go1 outer = listArray (0, length outer-1) (map go2 outer)
|
||||
go2 inner = listArray (0, length inner-1) inner
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
data MerkleProof = MkMerkleProof
|
||||
{ _leafIndex :: Int -- ^ linear index of the leaf we prove, 0..dataSize-1
|
||||
, _leafData :: Fr -- ^ the data on the leaf
|
||||
, _merklePath :: [Fr] -- ^ the path up the root
|
||||
, _dataSize :: Int -- ^ number of leaves in the tree
|
||||
{ _flavour :: !Flavour -- ^ which hash function
|
||||
, _leafIndex :: !Int -- ^ linear index of the leaf we prove, 0..dataSize-1
|
||||
, _leafData :: !Fr -- ^ the data on the leaf
|
||||
, _merklePath :: [Fr] -- ^ the path up the root
|
||||
, _dataSize :: !Int -- ^ number of leaves in the tree
|
||||
}
|
||||
deriving (Eq,Show)
|
||||
|
||||
@ -97,7 +98,7 @@ arrayLength arr = (b - a + 1) where (a,b) = bounds arr
|
||||
|
||||
-- | Returns the leaf and Merkle path of the given leaf
|
||||
extractMerkleProof :: MerkleTree -> Int -> MerkleProof
|
||||
extractMerkleProof tree@(MkMerkleTree outer) idx = MkMerkleProof idx leaf path size where
|
||||
extractMerkleProof tree@(MkMerkleTree flavour outer) idx = MkMerkleProof flavour idx leaf path size where
|
||||
leaf = (outer!0)!idx
|
||||
size = arrayLength (outer!0)
|
||||
depth = depthOf tree
|
||||
@ -112,12 +113,12 @@ extractMerkleProof_ :: MerkleTree -> Int -> [Fr]
|
||||
extractMerkleProof_ tree idx = _merklePath (extractMerkleProof tree idx)
|
||||
|
||||
reconstructMerkleRoot :: MerkleProof -> Fr
|
||||
reconstructMerkleRoot (MkMerkleProof idx leaf path size) = go layerFlags size idx leaf path where
|
||||
reconstructMerkleRoot (MkMerkleProof flavour idx leaf path size) = go layerFlags size idx leaf path where
|
||||
go _ !sz 0 !h [] = h
|
||||
go (f:fs) !sz !j !h !(p:ps) = case (j.&.1, j==sz-1) of
|
||||
(0, False) -> go fs sz' j' (evenOddCompressPair f $ Right (h,p)) ps
|
||||
(0, True ) -> go fs sz' j' (evenOddCompressPair f $ Left h ) ps
|
||||
(1, _ ) -> go fs sz' j' (evenOddCompressPair f $ Right (p,h)) ps
|
||||
(0, False) -> go fs sz' j' (evenOddCompressPair flavour f $ Right (h,p)) ps
|
||||
(0, True ) -> go fs sz' j' (evenOddCompressPair flavour f $ Left h ) ps
|
||||
(1, _ ) -> go fs sz' j' (evenOddCompressPair flavour f $ Right (p,h)) ps
|
||||
where
|
||||
sz' = shiftR (sz+1) 1
|
||||
j' = shiftR j 1
|
||||
@ -133,18 +134,18 @@ reconstructMerkleRoot (MkMerkleProof idx leaf path) = go idx leaf path where
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
testAllMerkleProofs :: Int -> IO ()
|
||||
testAllMerkleProofs nn = forM_ [1..nn] $ \k -> do
|
||||
let ok = if testMerkleProofs k then "OK." else "FAILED!!"
|
||||
putStrLn $ "testing Merkle proofs for a tree with " ++ show k ++ " leaves: " ++ ok
|
||||
testAllMerkleProofs :: Flavour -> Int -> IO ()
|
||||
testAllMerkleProofs flavour nn = forM_ [1..nn] $ \k -> do
|
||||
let ok = if testMerkleProofs flavour k then "OK." else "FAILED!!"
|
||||
putStrLn $ "testing Merkle proofs [" ++ show flavour ++ "] for a tree with " ++ show k ++ " leaves: " ++ ok
|
||||
|
||||
testMerkleProofs :: Int -> Bool
|
||||
testMerkleProofs = and . testMerkleProofs'
|
||||
testMerkleProofs :: Flavour -> Int -> Bool
|
||||
testMerkleProofs flavour = and . testMerkleProofs' flavour
|
||||
|
||||
testMerkleProofs' :: Int -> [Bool]
|
||||
testMerkleProofs' n = oks where
|
||||
testMerkleProofs' :: Flavour -> Int -> [Bool]
|
||||
testMerkleProofs' flavour n = oks where
|
||||
input = map fromIntegral [1001..1000+n] :: [Fr]
|
||||
tree = calcMerkleTree input
|
||||
tree = calcMerkleTree flavour input
|
||||
root = merkleRootOf tree
|
||||
oks = [ reconstructMerkleRoot prf == root
|
||||
| j<-[0..n-1]
|
||||
@ -174,33 +175,33 @@ nodeKey BottomLayer EvenNode = 0x01
|
||||
nodeKey OtherLayer OddNode = 0x02
|
||||
nodeKey BottomLayer OddNode = 0x03
|
||||
|
||||
evenOddCompressPair :: LayerFlag -> Either Fr (Fr,Fr) -> Fr
|
||||
evenOddCompressPair !lf (Right (x,y)) = keyedCompression (nodeKey lf EvenNode) x y
|
||||
evenOddCompressPair !lf (Left x ) = keyedCompression (nodeKey lf OddNode ) x 0
|
||||
evenOddCompressPair :: Flavour -> LayerFlag -> Either Fr (Fr,Fr) -> Fr
|
||||
evenOddCompressPair !flavour !lf (Right (x,y)) = keyedCompression flavour (nodeKey lf EvenNode) x y
|
||||
evenOddCompressPair !flavour !lf (Left x ) = keyedCompression flavour (nodeKey lf OddNode ) x 0
|
||||
|
||||
layerFlags :: [LayerFlag]
|
||||
layerFlags = BottomLayer : repeat OtherLayer
|
||||
|
||||
calcMerkleRoot :: [Fr] -> Fr
|
||||
calcMerkleRoot input =
|
||||
calcMerkleRoot :: Flavour -> [Fr] -> Fr
|
||||
calcMerkleRoot flavour input =
|
||||
case input of
|
||||
[] -> error "calcMerkleRoot: input is empty"
|
||||
[z] -> keyedCompression (nodeKey BottomLayer OddNode) z 0
|
||||
[z] -> keyedCompression flavour (nodeKey BottomLayer OddNode) z 0
|
||||
zs -> go layerFlags zs
|
||||
where
|
||||
go :: [LayerFlag] -> [Fr] -> Fr
|
||||
go _ [x] = x
|
||||
go (f:fs) xs = go fs (map (evenOddCompressPair f) $ eiPairs xs)
|
||||
go (f:fs) xs = go fs (map (evenOddCompressPair flavour f) $ eiPairs xs)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
type Key = Fr
|
||||
|
||||
keyedCompressPair :: Key -> (Fr,Fr) -> Fr
|
||||
keyedCompressPair !key (!x,!y) = keyedCompression key x y
|
||||
keyedCompressPair :: Flavour -> Key -> (Fr,Fr) -> Fr
|
||||
keyedCompressPair !flavour !key (!x,!y) = keyedCompression flavour key x y
|
||||
|
||||
keyedCompression :: Key -> Fr -> Fr -> Fr
|
||||
keyedCompression !key !x !y = case permutation (x,y,key) of (z,_,_) -> z
|
||||
keyedCompression :: Flavour -> Key -> Fr -> Fr -> Fr
|
||||
keyedCompression !flavour !key !x !y = case permutation flavour (x,y,key) of (z,_,_) -> z
|
||||
|
||||
eiPairs :: [Fr] -> [Either Fr (Fr,Fr)]
|
||||
eiPairs [] = []
|
||||
@ -209,11 +210,11 @@ eiPairs (x:y:rest) = Right (x,y) : eiPairs rest
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
compressPair :: (Fr,Fr) -> Fr
|
||||
compressPair (x,y) = compression x y
|
||||
compressPair :: Flavour -> (Fr,Fr) -> Fr
|
||||
compressPair !flavour !(x,y) = compression flavour x y
|
||||
|
||||
compression :: Fr -> Fr -> Fr
|
||||
compression x y = case permutation (x,y,0) of (z,_,_) -> z
|
||||
compression :: Flavour -> Fr -> Fr -> Fr
|
||||
compression !flavour !x !y = case permutation flavour (x,y,0) of (z,_,_) -> z
|
||||
|
||||
{-
|
||||
pairs :: [Fr] -> [(Fr,Fr)]
|
||||
@ -224,14 +225,25 @@ pairs (x:y:rest) = (x,y) : pairs rest
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
printExampleMerkleRoots' :: Flavour -> IO ()
|
||||
printExampleMerkleRoots' flavour = do
|
||||
putStrLn $ "Merkle root for [1.. 1] = " ++ show (calcMerkleRoot flavour $ map fromInteger [1.. 1])
|
||||
putStrLn $ "Merkle root for [1.. 2] = " ++ show (calcMerkleRoot flavour $ map fromInteger [1.. 2])
|
||||
putStrLn $ "Merkle root for [1.. 4] = " ++ show (calcMerkleRoot flavour $ map fromInteger [1.. 4])
|
||||
putStrLn $ "Merkle root for [1.. 16] = " ++ show (calcMerkleRoot flavour $ map fromInteger [1.. 16])
|
||||
putStrLn $ "Merkle root for [1.. 64] = " ++ show (calcMerkleRoot flavour $ map fromInteger [1.. 64])
|
||||
putStrLn $ "Merkle root for [1.. 256] = " ++ show (calcMerkleRoot flavour $ map fromInteger [1.. 256])
|
||||
putStrLn $ "Merkle root for [1..1024] = " ++ show (calcMerkleRoot flavour $ map fromInteger [1..1024])
|
||||
|
||||
printExampleMerkleRoots :: IO ()
|
||||
printExampleMerkleRoots = do
|
||||
putStrLn $ "Merkle root for [1.. 1] = " ++ show (calcMerkleRoot $ map fromInteger [1.. 1])
|
||||
putStrLn $ "Merkle root for [1.. 2] = " ++ show (calcMerkleRoot $ map fromInteger [1.. 2])
|
||||
putStrLn $ "Merkle root for [1.. 4] = " ++ show (calcMerkleRoot $ map fromInteger [1.. 4])
|
||||
putStrLn $ "Merkle root for [1.. 16] = " ++ show (calcMerkleRoot $ map fromInteger [1.. 16])
|
||||
putStrLn $ "Merkle root for [1.. 64] = " ++ show (calcMerkleRoot $ map fromInteger [1.. 64])
|
||||
putStrLn $ "Merkle root for [1.. 256] = " ++ show (calcMerkleRoot $ map fromInteger [1.. 256])
|
||||
putStrLn $ "Merkle root for [1..1024] = " ++ show (calcMerkleRoot $ map fromInteger [1..1024])
|
||||
|
||||
putStrLn "using the \"old\" constants:"
|
||||
putStrLn "--------------------------"
|
||||
printExampleMerkleRoots' HorizenLabsOld
|
||||
|
||||
putStrLn "using the \"new\" constants:"
|
||||
putStrLn "--------------------------"
|
||||
printExampleMerkleRoots' HorizenLabsNew
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
@ -1,23 +1,33 @@
|
||||
|
||||
-- | The Poseidon2 permutation
|
||||
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
module Poseidon2.Permutation where
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
import ZK.Algebra.Curves.BN128.Fr.Mont (Fr)
|
||||
|
||||
import Poseidon2.RoundConsts
|
||||
import qualified Poseidon2.RoundConstsOld as Old
|
||||
import qualified Poseidon2.RoundConstsNew as New
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
-- | Which set of round constants
|
||||
data Flavour
|
||||
= HorizenLabsOld
|
||||
| HorizenLabsNew
|
||||
deriving (Eq, Show)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
sbox :: Fr -> Fr
|
||||
sbox x = x4*x where
|
||||
sbox !x = x4*x where
|
||||
x2 = x *x
|
||||
x4 = x2*x2
|
||||
|
||||
internalRound :: Fr -> (Fr,Fr,Fr) -> (Fr,Fr,Fr)
|
||||
internalRound c (x,y,z) =
|
||||
internalRound !c (x,y,z) =
|
||||
( 2*x' + y + z
|
||||
, x' + 2*y + z
|
||||
, x' + y + 3*z
|
||||
@ -26,22 +36,34 @@ internalRound c (x,y,z) =
|
||||
x' = sbox (x + c)
|
||||
|
||||
externalRound :: (Fr,Fr,Fr) -> (Fr,Fr,Fr) -> (Fr,Fr,Fr)
|
||||
externalRound (cx,cy,cz) (x,y,z) = (x'+s , y'+s , z'+s) where
|
||||
externalRound !(cx,cy,cz) !(x,y,z) = (x'+s , y'+s , z'+s) where
|
||||
x' = sbox (x + cx)
|
||||
y' = sbox (y + cy)
|
||||
z' = sbox (z + cz)
|
||||
s = x' + y' + z'
|
||||
|
||||
linearLayer :: (Fr,Fr,Fr) -> (Fr,Fr,Fr)
|
||||
linearLayer (x,y,z) = (x+s, y+s, z+s) where s = x+y+z
|
||||
linearLayer !(x,y,z) = (x+s, y+s, z+s) where s = x+y+z
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
permutation :: (Fr,Fr,Fr) -> (Fr,Fr,Fr)
|
||||
permutation
|
||||
= (\state -> foldl (flip externalRound) state finalRoundConsts )
|
||||
. (\state -> foldl (flip internalRound) state internalRoundConsts)
|
||||
. (\state -> foldl (flip externalRound) state initialRoundConsts )
|
||||
permutationOld :: (Fr,Fr,Fr) -> (Fr,Fr,Fr)
|
||||
permutationOld
|
||||
= (\state -> foldl (flip externalRound) state Old.finalRoundConsts )
|
||||
. (\state -> foldl (flip internalRound) state Old.internalRoundConsts)
|
||||
. (\state -> foldl (flip externalRound) state Old.initialRoundConsts )
|
||||
. linearLayer
|
||||
|
||||
|
||||
permutationNew :: (Fr,Fr,Fr) -> (Fr,Fr,Fr)
|
||||
permutationNew
|
||||
= (\state -> foldl (flip externalRound) state New.finalRoundConsts )
|
||||
. (\state -> foldl (flip internalRound) state New.internalRoundConsts)
|
||||
. (\state -> foldl (flip externalRound) state New.initialRoundConsts )
|
||||
. linearLayer
|
||||
|
||||
permutation :: Flavour -> (Fr,Fr,Fr) -> (Fr,Fr,Fr)
|
||||
permutation HorizenLabsOld = permutationOld
|
||||
permutation HorizenLabsNew = permutationNew
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
131
reference/haskell/src/Poseidon2/RoundConstsNew.hs
Normal file
131
reference/haskell/src/Poseidon2/RoundConstsNew.hs
Normal file
@ -0,0 +1,131 @@
|
||||
|
||||
-- | BN256 prime, and t = 3
|
||||
|
||||
module Poseidon2.RoundConstsNew where
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
import ZK.Algebra.Curves.BN128.Fr.Mont
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
{-
|
||||
matDiag3 :: [[Fr]]
|
||||
matDiag3 =
|
||||
[ [1,0,0]
|
||||
, [0,1,0]
|
||||
, [0,0,2]
|
||||
]
|
||||
|
||||
matInternal3 :: [[Fr]]
|
||||
matInternal3 =
|
||||
[ [2,1,1]
|
||||
, [1,2,1]
|
||||
, [1,1,3]
|
||||
]
|
||||
-}
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
initialRoundConsts :: [(Fr,Fr,Fr)]
|
||||
initialRoundConsts =
|
||||
[ ( 0x1d066a255517b7fd8bddd3a93f7804ef7f8fcde48bb4c37a59a09a1a97052816
|
||||
, 0x29daefb55f6f2dc6ac3f089cebcc6120b7c6fef31367b68eb7238547d32c1610
|
||||
, 0x1f2cb1624a78ee001ecbd88ad959d7012572d76f08ec5c4f9e8b7ad7b0b4e1d1
|
||||
)
|
||||
, ( 0x0aad2e79f15735f2bd77c0ed3d14aa27b11f092a53bbc6e1db0672ded84f31e5
|
||||
, 0x2252624f8617738cd6f661dd4094375f37028a98f1dece66091ccf1595b43f28
|
||||
, 0x1a24913a928b38485a65a84a291da1ff91c20626524b2b87d49f4f2c9018d735
|
||||
)
|
||||
, ( 0x22fc468f1759b74d7bfc427b5f11ebb10a41515ddff497b14fd6dae1508fc47a
|
||||
, 0x1059ca787f1f89ed9cd026e9c9ca107ae61956ff0b4121d5efd65515617f6e4d
|
||||
, 0x02be9473358461d8f61f3536d877de982123011f0bf6f155a45cbbfae8b981ce
|
||||
)
|
||||
, ( 0x0ec96c8e32962d462778a749c82ed623aba9b669ac5b8736a1ff3a441a5084a4
|
||||
, 0x292f906e073677405442d9553c45fa3f5a47a7cdb8c99f9648fb2e4d814df57e
|
||||
, 0x274982444157b86726c11b9a0f5e39a5cc611160a394ea460c63f0b2ffe5657e
|
||||
)
|
||||
]
|
||||
|
||||
internalRoundConsts :: [Fr]
|
||||
internalRoundConsts =
|
||||
[ 0x1a1d063e54b1e764b63e1855bff015b8cedd192f47308731499573f23597d4b5
|
||||
, 0x26abc66f3fdf8e68839d10956259063708235dccc1aa3793b91b002c5b257c37
|
||||
, 0x0c7c64a9d887385381a578cfed5aed370754427aabca92a70b3c2b12ff4d7be8
|
||||
, 0x1cf5998769e9fab79e17f0b6d08b2d1eba2ebac30dc386b0edd383831354b495
|
||||
, 0x0f5e3a8566be31b7564ca60461e9e08b19828764a9669bc17aba0b97e66b0109
|
||||
, 0x18df6a9d19ea90d895e60e4db0794a01f359a53a180b7d4b42bf3d7a531c976e
|
||||
, 0x04f7bf2c5c0538ac6e4b782c3c6e601ad0ea1d3a3b9d25ef4e324055fa3123dc
|
||||
, 0x29c76ce22255206e3c40058523748531e770c0584aa2328ce55d54628b89ebe6
|
||||
, 0x198d425a45b78e85c053659ab4347f5d65b1b8e9c6108dbe00e0e945dbc5ff15
|
||||
, 0x25ee27ab6296cd5e6af3cc79c598a1daa7ff7f6878b3c49d49d3a9a90c3fdf74
|
||||
, 0x138ea8e0af41a1e024561001c0b6eb1505845d7d0c55b1b2c0f88687a96d1381
|
||||
, 0x306197fb3fab671ef6e7c2cba2eefd0e42851b5b9811f2ca4013370a01d95687
|
||||
, 0x1a0c7d52dc32a4432b66f0b4894d4f1a21db7565e5b4250486419eaf00e8f620
|
||||
, 0x2b46b418de80915f3ff86a8e5c8bdfccebfbe5f55163cd6caa52997da2c54a9f
|
||||
, 0x12d3e0dc0085873701f8b777b9673af9613a1af5db48e05bfb46e312b5829f64
|
||||
, 0x263390cf74dc3a8870f5002ed21d089ffb2bf768230f648dba338a5cb19b3a1f
|
||||
, 0x0a14f33a5fe668a60ac884b4ca607ad0f8abb5af40f96f1d7d543db52b003dcd
|
||||
, 0x28ead9c586513eab1a5e86509d68b2da27be3a4f01171a1dd847df829bc683b9
|
||||
, 0x1c6ab1c328c3c6430972031f1bdb2ac9888f0ea1abe71cffea16cda6e1a7416c
|
||||
, 0x1fc7e71bc0b819792b2500239f7f8de04f6decd608cb98a932346015c5b42c94
|
||||
, 0x03e107eb3a42b2ece380e0d860298f17c0c1e197c952650ee6dd85b93a0ddaa8
|
||||
, 0x2d354a251f381a4669c0d52bf88b772c46452ca57c08697f454505f6941d78cd
|
||||
, 0x094af88ab05d94baf687ef14bc566d1c522551d61606eda3d14b4606826f794b
|
||||
, 0x19705b783bf3d2dc19bcaeabf02f8ca5e1ab5b6f2e3195a9d52b2d249d1396f7
|
||||
, 0x09bf4acc3a8bce3f1fcc33fee54fc5b28723b16b7d740a3e60cef6852271200e
|
||||
, 0x1803f8200db6013c50f83c0c8fab62843413732f301f7058543a073f3f3b5e4e
|
||||
, 0x0f80afb5046244de30595b160b8d1f38bf6fb02d4454c0add41f7fef2faf3e5c
|
||||
, 0x126ee1f8504f15c3d77f0088c1cfc964abcfcf643f4a6fea7dc3f98219529d78
|
||||
, 0x23c203d10cfcc60f69bfb3d919552ca10ffb4ee63175ddf8ef86f991d7d0a591
|
||||
, 0x2a2ae15d8b143709ec0d09705fa3a6303dec1ee4eec2cf747c5a339f7744fb94
|
||||
, 0x07b60dee586ed6ef47e5c381ab6343ecc3d3b3006cb461bbb6b5d89081970b2b
|
||||
, 0x27316b559be3edfd885d95c494c1ae3d8a98a320baa7d152132cfe583c9311bd
|
||||
, 0x1d5c49ba157c32b8d8937cb2d3f84311ef834cc2a743ed662f5f9af0c0342e76
|
||||
, 0x2f8b124e78163b2f332774e0b850b5ec09c01bf6979938f67c24bd5940968488
|
||||
, 0x1e6843a5457416b6dc5b7aa09a9ce21b1d4cba6554e51d84665f75260113b3d5
|
||||
, 0x11cdf00a35f650c55fca25c9929c8ad9a68daf9ac6a189ab1f5bc79f21641d4b
|
||||
, 0x21632de3d3bbc5e42ef36e588158d6d4608b2815c77355b7e82b5b9b7eb560bc
|
||||
, 0x0de625758452efbd97b27025fbd245e0255ae48ef2a329e449d7b5c51c18498a
|
||||
, 0x2ad253c053e75213e2febfd4d976cc01dd9e1e1c6f0fb6b09b09546ba0838098
|
||||
, 0x1d6b169ed63872dc6ec7681ec39b3be93dd49cdd13c813b7d35702e38d60b077
|
||||
, 0x1660b740a143664bb9127c4941b67fed0be3ea70a24d5568c3a54e706cfef7fe
|
||||
, 0x0065a92d1de81f34114f4ca2deef76e0ceacdddb12cf879096a29f10376ccbfe
|
||||
, 0x1f11f065202535987367f823da7d672c353ebe2ccbc4869bcf30d50a5871040d
|
||||
, 0x26596f5c5dd5a5d1b437ce7b14a2c3dd3bd1d1a39b6759ba110852d17df0693e
|
||||
, 0x16f49bc727e45a2f7bf3056efcf8b6d38539c4163a5f1e706743db15af91860f
|
||||
, 0x1abe1deb45b3e3119954175efb331bf4568feaf7ea8b3dc5e1a4e7438dd39e5f
|
||||
, 0x0e426ccab66984d1d8993a74ca548b779f5db92aaec5f102020d34aea15fba59
|
||||
, 0x0e7c30c2e2e8957f4933bd1942053f1f0071684b902d534fa841924303f6a6c6
|
||||
, 0x0812a017ca92cf0a1622708fc7edff1d6166ded6e3528ead4c76e1f31d3fc69d
|
||||
, 0x21a5ade3df2bc1b5bba949d1db96040068afe5026edd7a9c2e276b47cf010d54
|
||||
, 0x01f3035463816c84ad711bf1a058c6c6bd101945f50e5afe72b1a5233f8749ce
|
||||
, 0x0b115572f038c0e2028c2aafc2d06a5e8bf2f9398dbd0fdf4dcaa82b0f0c1c8b
|
||||
, 0x1c38ec0b99b62fd4f0ef255543f50d2e27fc24db42bc910a3460613b6ef59e2f
|
||||
, 0x1c89c6d9666272e8425c3ff1f4ac737b2f5d314606a297d4b1d0b254d880c53e
|
||||
, 0x03326e643580356bf6d44008ae4c042a21ad4880097a5eb38b71e2311bb88f8f
|
||||
, 0x268076b0054fb73f67cee9ea0e51e3ad50f27a6434b5dceb5bdde2299910a4c9
|
||||
]
|
||||
|
||||
finalRoundConsts :: [(Fr,Fr,Fr)]
|
||||
finalRoundConsts =
|
||||
[ ( 0x1acd63c67fbc9ab1626ed93491bda32e5da18ea9d8e4f10178d04aa6f8747ad0
|
||||
, 0x19f8a5d670e8ab66c4e3144be58ef6901bf93375e2323ec3ca8c86cd2a28b5a5
|
||||
, 0x1c0dc443519ad7a86efa40d2df10a011068193ea51f6c92ae1cfbb5f7b9b6893
|
||||
)
|
||||
, ( 0x14b39e7aa4068dbe50fe7190e421dc19fbeab33cb4f6a2c4180e4c3224987d3d
|
||||
, 0x1d449b71bd826ec58f28c63ea6c561b7b820fc519f01f021afb1e35e28b0795e
|
||||
, 0x1ea2c9a89baaddbb60fa97fe60fe9d8e89de141689d1252276524dc0a9e987fc
|
||||
)
|
||||
, ( 0x0478d66d43535a8cb57e9c1c3d6a2bd7591f9a46a0e9c058134d5cefdb3c7ff1
|
||||
, 0x19272db71eece6a6f608f3b2717f9cd2662e26ad86c400b21cde5e4a7b00bebe
|
||||
, 0x14226537335cab33c749c746f09208abb2dd1bd66a87ef75039be846af134166
|
||||
)
|
||||
, ( 0x01fd6af15956294f9dfe38c0d976a088b21c21e4a1c2e823f912f44961f9a9ce
|
||||
, 0x18e5abedd626ec307bca190b8b2cab1aaee2e62ed229ba5a5ad8518d4e5f2a57
|
||||
, 0x0fc1bbceba0590f5abbdffa6d3b35e3297c021a3a409926d0e2d54dc1c84fda6
|
||||
)
|
||||
]
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
@ -1,7 +1,7 @@
|
||||
|
||||
-- | BN256 prime, and t = 3
|
||||
|
||||
module Poseidon2.RoundConsts where
|
||||
module Poseidon2.RoundConstsOld where
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
@ -1,5 +1,11 @@
|
||||
|
||||
module Poseidon2.Sponge where
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
module Poseidon2.Sponge
|
||||
( Flavour(..)
|
||||
, sponge1
|
||||
, sponge2
|
||||
)
|
||||
where
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
@ -10,8 +16,8 @@ import Poseidon2.Permutation
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
-- | Sponge construction with rate=1 (capacity=2), zero IV and 10* padding
|
||||
sponge1 :: [Fr] -> Fr
|
||||
sponge1 input = go (0,0,civ) (pad input) where
|
||||
sponge1 :: Flavour -> [Fr] -> Fr
|
||||
sponge1 !flavour input = go (0,0,civ) (pad input) where
|
||||
|
||||
-- domain separation: capacity IV = 2^64 + 256*t + rate
|
||||
civ = fromInteger (2^64 + 0x0301)
|
||||
@ -22,13 +28,13 @@ sponge1 input = go (0,0,civ) (pad input) where
|
||||
|
||||
go (sx,_ ,_ ) [] = sx
|
||||
go (sx,sy,sz) (a:as) = go state' as where
|
||||
state' = permutation (sx+a, sy, sz)
|
||||
state' = permutation flavour (sx+a, sy, sz)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
-- | Sponge construction with rate=2 (capacity=1), zero IV and 10* padding
|
||||
sponge2 :: [Fr] -> Fr
|
||||
sponge2 input = go (0,0,civ) (pad input) where
|
||||
sponge2 :: Flavour -> [Fr] -> Fr
|
||||
sponge2 !flavour input = go (0,0,civ) (pad input) where
|
||||
|
||||
-- domain separation: capacity IV = 2^64 + 256*t + rate
|
||||
civ = fromInteger (2^64 + 0x0302)
|
||||
@ -40,7 +46,7 @@ sponge2 input = go (0,0,civ) (pad input) where
|
||||
|
||||
go (sx,_ ,_ ) [] = sx
|
||||
go (sx,sy,sz) (a:b:rest) = go state' rest where
|
||||
state' = permutation (sx+a, sy+b, sz)
|
||||
state' = permutation flavour (sx+a, sy+b, sz)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
|
||||
@ -30,7 +30,7 @@ type Entropy = Fr
|
||||
-- cell index to sample
|
||||
sampleCellIndex :: SlotConfig -> Entropy -> Hash -> Int -> CellIdx
|
||||
sampleCellIndex cfg entropy slotRoot counter = CellIdx (fromInteger idx) where
|
||||
u = sponge2 [entropy , slotRoot , fromIntegral counter] :: Fr
|
||||
u = sponge2 (Slot._hashFlavour cfg) [entropy , slotRoot , fromIntegral counter] :: Fr
|
||||
idx = (Fr.from u) `mod` n :: Integer
|
||||
n = (fromIntegral $ Slot._nCells cfg) :: Integer
|
||||
|
||||
@ -62,12 +62,13 @@ data CircuitInput = MkInput
|
||||
calculateCircuitInput :: DataSetCfg -> SlotIdx -> Entropy -> IO CircuitInput
|
||||
calculateCircuitInput dataSetCfg slotIdx@(SlotIdx sidx) entropy = do
|
||||
let nslots = _nSlots dataSetCfg
|
||||
let flavour = DataSet._hashFlavour dataSetCfg
|
||||
|
||||
let slotCfgs = [ dataSetSlotCfg dataSetCfg (SlotIdx i) | i <- [0..nslots-1] ]
|
||||
slotTrees <- mapM calcSlotTree slotCfgs
|
||||
let !slotRoots = map slotTreeRoot slotTrees
|
||||
let !dsetTree = calcMerkleTree slotRoots
|
||||
let !dsetRoot = merkleRootOf dsetTree
|
||||
let !dsetTree = calcMerkleTree flavour slotRoots
|
||||
let !dsetRoot = merkleRootOf dsetTree
|
||||
|
||||
let ourSlotCfg = slotCfgs !! sidx
|
||||
let ourSlotRoot = slotRoots !! sidx
|
||||
|
||||
@ -49,11 +49,12 @@ data DataSource
|
||||
deriving Show
|
||||
|
||||
data SlotConfig = MkSlotCfg
|
||||
{ _cellSize :: Int -- ^ cell size in bytes (eg. 2048)
|
||||
, _blockSize :: Int -- ^ block size in bytes (eg. 65536)
|
||||
, _nCells :: Int -- ^ number of cells per slot (should be power of two)
|
||||
, _nSamples :: Int -- ^ how many cells we sample
|
||||
, _dataSrc :: DataSource -- ^ slot data source
|
||||
{ _cellSize :: Int -- ^ cell size in bytes (eg. 2048)
|
||||
, _blockSize :: Int -- ^ block size in bytes (eg. 65536)
|
||||
, _nCells :: Int -- ^ number of cells per slot (should be power of two)
|
||||
, _nSamples :: Int -- ^ how many cells we sample
|
||||
, _hashFlavour :: Flavour -- ^ which hash function instance to use
|
||||
, _dataSrc :: DataSource -- ^ slot data source
|
||||
}
|
||||
deriving Show
|
||||
|
||||
@ -71,11 +72,12 @@ blocksPerSlot cfg = case divMod (_nCells cfg) (cellsPerBlock cfg) of
|
||||
-- | Example slot configuration
|
||||
exSlotCfg :: SlotConfig
|
||||
exSlotCfg = MkSlotCfg
|
||||
{ _cellSize = 256
|
||||
, _blockSize = 4096
|
||||
, _nCells = 1024
|
||||
, _nSamples = 20
|
||||
, _dataSrc = FakeData (Seed 12345)
|
||||
{ _cellSize = 256
|
||||
, _blockSize = 4096
|
||||
, _nCells = 1024
|
||||
, _nSamples = 20
|
||||
, _hashFlavour = HorizenLabsOld
|
||||
, _dataSrc = FakeData (Seed 12345)
|
||||
}
|
||||
|
||||
fieldElemsPerCell :: SlotConfig -> Int
|
||||
@ -153,7 +155,7 @@ calcBlockTree cfg idx = do
|
||||
block <- loadBlockData cfg idx
|
||||
let cells = splitBlockToCells cfg block
|
||||
let cellHashes = map (hashCell cfg) cells
|
||||
let tree = calcMerkleTree cellHashes
|
||||
let tree = calcMerkleTree (_hashFlavour cfg) cellHashes
|
||||
return tree
|
||||
|
||||
calcAllBlockTrees :: SlotConfig -> IO (Array Int MerkleTree)
|
||||
@ -175,7 +177,7 @@ slotTreeRoot = merkleRootOf . _bigTree
|
||||
calcSlotTree :: SlotConfig -> IO SlotTree
|
||||
calcSlotTree cfg = do
|
||||
minitrees <- calcAllBlockTrees cfg
|
||||
let bigtree = calcMerkleTree $ map merkleRootOf $ elems minitrees
|
||||
let bigtree = calcMerkleTree (_hashFlavour cfg) $ map merkleRootOf $ elems minitrees
|
||||
return $ MkSlotTree minitrees bigtree
|
||||
|
||||
extractCellProof :: SlotConfig -> SlotTree -> CellIdx -> [Hash]
|
||||
@ -201,13 +203,15 @@ checkCellProof cfg slotTree (CellIdx cellIdx) cellHash path
|
||||
inBlockCellIdx = cellIdx .&. (k-1)
|
||||
|
||||
smallProof = MkMerkleProof
|
||||
{ _leafIndex = inBlockCellIdx
|
||||
{ _flavour = _hashFlavour cfg
|
||||
, _leafIndex = inBlockCellIdx
|
||||
, _leafData = cellHash
|
||||
, _merklePath = take logK path
|
||||
, _dataSize = k
|
||||
}
|
||||
bigProof = MkMerkleProof
|
||||
{ _leafIndex = blockIdx
|
||||
{ _flavour = _hashFlavour cfg
|
||||
, _leafIndex = blockIdx
|
||||
, _leafData = blockHash
|
||||
, _merklePath = drop logK path
|
||||
, _dataSize = m
|
||||
@ -222,10 +226,12 @@ checkCellProof cfg slotTree (CellIdx cellIdx) cellHash path
|
||||
hashCell :: SlotConfig -> CellData -> Hash
|
||||
hashCell cfg (CellData rawdata)
|
||||
| B.length rawdata /= _cellSize cfg = error "hashCell: invalid cell data size"
|
||||
| otherwise = hashCell_ rawdata
|
||||
| otherwise = hashCell_ flavour rawdata
|
||||
where
|
||||
flavour = _hashFlavour cfg
|
||||
|
||||
hashCell_ :: ByteString -> Hash
|
||||
hashCell_ rawdata = sponge2 (cellDataToFieldElements $ CellData rawdata)
|
||||
hashCell_ :: Flavour -> ByteString -> Hash
|
||||
hashCell_ flavour rawdata = sponge2 flavour (cellDataToFieldElements $ CellData rawdata)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
|
||||
@ -18,60 +18,70 @@ import ZK.Algebra.Curves.BN128.Fr.Mont (Fr)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
allTestVectors :: IO ()
|
||||
allTestVectors = do
|
||||
testVectorsSponge
|
||||
testVectorsHash
|
||||
testVectorsMerkle
|
||||
putStrLn "\nTEST VECTORS FOR *OLD* ROUND CONSTANTS"
|
||||
putStrLn "======================================"
|
||||
allTestVectors' HorizenLabsOld
|
||||
putStrLn "\nTEST VECTORS FOR *NEW* ROUND CONSTANTS"
|
||||
putStrLn "======================================"
|
||||
allTestVectors' HorizenLabsNew
|
||||
|
||||
allTestVectors' :: Flavour -> IO ()
|
||||
allTestVectors' flavour = do
|
||||
testVectorsSponge flavour
|
||||
testVectorsHash flavour
|
||||
testVectorsMerkle flavour
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
testVectorsSponge :: IO ()
|
||||
testVectorsSponge = do
|
||||
testVectorsSponge :: Flavour -> IO ()
|
||||
testVectorsSponge flavour = do
|
||||
putStrLn ""
|
||||
putStrLn "test vectors for sponge of field elements with rate=1"
|
||||
putStrLn "-----------------------------------------------------"
|
||||
putStrLn $ "test vectors for sponge of field elements with rate=1 | " ++ show flavour
|
||||
putStrLn "-------------------------------------------------------------------"
|
||||
forM_ [0..8] $ \n -> do
|
||||
let input = map fromIntegral [1..n] :: [Fr]
|
||||
putStrLn $ "hash of [1.." ++ show n ++ "] :: [Fr] = " ++ show (sponge1 input)
|
||||
putStrLn $ "hash of [1.." ++ show n ++ "] :: [Fr] = " ++ show (sponge1 flavour input)
|
||||
|
||||
putStrLn ""
|
||||
putStrLn "test vectors for sponge of field elements with rate=2"
|
||||
putStrLn "-----------------------------------------------------"
|
||||
putStrLn $ "test vectors for sponge of field elements with rate=2 | " ++ show flavour
|
||||
putStrLn "-------------------------------------------------------------------"
|
||||
forM_ [0..8] $ \n -> do
|
||||
let input = map fromIntegral [1..n] :: [Fr]
|
||||
putStrLn $ "hash of [1.." ++ show n ++ "] :: [Fr] = " ++ show (sponge2 input)
|
||||
putStrLn $ "hash of [1.." ++ show n ++ "] :: [Fr] = " ++ show (sponge2 flavour input)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
testVectorsHash :: IO ()
|
||||
testVectorsHash = do
|
||||
testVectorsHash :: Flavour -> IO ()
|
||||
testVectorsHash flavour = do
|
||||
|
||||
putStrLn ""
|
||||
putStrLn "test vectors for hash (padded sponge with rate=2) of bytes"
|
||||
putStrLn $ "test vectors for hash (padded sponge with rate=2) of bytes | " ++ show flavour
|
||||
putStrLn "----------------------------------------------------------"
|
||||
forM_ [0..80] $ \n -> do
|
||||
let input = map fromIntegral [1..n] :: [Word8]
|
||||
let bs = B.pack input
|
||||
putStrLn $ "hash of [1.." ++ show n ++ "] :: [Byte] = " ++ show (hashCell_ bs)
|
||||
putStrLn $ "hash of [1.." ++ show n ++ "] :: [Byte] = " ++ show (hashCell_ flavour bs)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
testVectorsMerkle :: IO ()
|
||||
testVectorsMerkle = do
|
||||
testVectorsMerkle :: Flavour -> IO ()
|
||||
testVectorsMerkle flavour = do
|
||||
putStrLn ""
|
||||
putStrLn "test vectors for Merkle roots of field elements"
|
||||
putStrLn $ "test vectors for Merkle roots of field elements | " ++ show flavour
|
||||
putStrLn "-----------------------------------------------"
|
||||
forM_ [1..40] $ \n -> do
|
||||
let input = map fromIntegral [1..n] :: [Fr]
|
||||
putStrLn $ "Merkle root of [1.." ++ show n ++ "] :: [Fr] = " ++ show (calcMerkleRoot input)
|
||||
putStrLn $ "Merkle root of [1.." ++ show n ++ "] :: [Fr] = " ++ show (calcMerkleRoot flavour input)
|
||||
|
||||
putStrLn ""
|
||||
putStrLn "test vectors for Merkle roots of sequence of bytes"
|
||||
putStrLn $ "test vectors for Merkle roots of sequence of bytes | " ++ show flavour
|
||||
putStrLn "--------------------------------------------------"
|
||||
forM_ [0..80] $ \n -> do
|
||||
let input = map fromIntegral [1..n] :: [Word8]
|
||||
let bs = B.pack input
|
||||
let flds = cellDataToFieldElements (CellData bs)
|
||||
putStrLn $ "Merkle root of [1.." ++ show n ++ "] :: [Byte] = " ++ show (calcMerkleRoot flds)
|
||||
putStrLn $ "Merkle root of [1.." ++ show n ++ "] :: [Byte] = " ++ show (calcMerkleRoot flavour flds)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
@ -41,7 +41,8 @@ Library
|
||||
Poseidon2.Example
|
||||
Poseidon2.Merkle
|
||||
Poseidon2.Permutation
|
||||
Poseidon2.RoundConsts
|
||||
Poseidon2.RoundConstsOld
|
||||
Poseidon2.RoundConstsNew
|
||||
Poseidon2.Sponge
|
||||
Misc
|
||||
TestVectors
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user