From 159b71959ced161c5759c252aff4f1a5d7b53e23 Mon Sep 17 00:00:00 2001 From: Balazs Komuves Date: Sat, 25 Nov 2023 14:24:25 +0100 Subject: [PATCH] updated the Haskell and Nim code to produce inputs for proving against the dataset root (instead of the slot root) --- reference/haskell/cli/testMain.hs | 30 +++++--- reference/haskell/src/DataSet.hs | 84 +++++++++++++++++++++ reference/haskell/src/Sampling.hs | 63 +++++++++++----- reference/haskell/src/Slot.hs | 28 ++----- reference/haskell/storage-proof-ref.cabal | 4 +- reference/nim/proof_input/src/dataset.nim | 56 ++++++++++++++ reference/nim/proof_input/src/gen_input.nim | 45 ++++++++--- reference/nim/proof_input/src/json.nim | 31 +++++--- reference/nim/proof_input/src/slot.nim | 33 ++++---- reference/nim/proof_input/src/testmain.nim | 6 +- reference/nim/proof_input/src/types.nim | 22 ++++-- 11 files changed, 304 insertions(+), 98 deletions(-) create mode 100644 reference/haskell/src/DataSet.hs create mode 100644 reference/nim/proof_input/src/dataset.nim diff --git a/reference/haskell/cli/testMain.hs b/reference/haskell/cli/testMain.hs index f009ff4..d6bb504 100644 --- a/reference/haskell/cli/testMain.hs +++ b/reference/haskell/cli/testMain.hs @@ -1,30 +1,40 @@ module Main where -import Slot +-------------------------------------------------------------------------------- + +import Slot ( SlotIdx(..) , DataSource(..) , Seed(..) ) +import DataSet import Sampling -smallSlotCfg :: SlotConfig -smallSlotCfg = MkSlotCfg - { _cellSize = 128 +-------------------------------------------------------------------------------- + +smallDataSetCfg :: DataSetCfg +smallDataSetCfg = MkDataSetCfg + { _nSlots = 5 + , _cellSize = 128 , _blockSize = 4096 , _nCells = 256 , _nSamples = 5 , _dataSrc = FakeData (Seed 12345) } -bigSlotCfg :: SlotConfig -bigSlotCfg = MkSlotCfg - { _cellSize = 2048 +bigDataSetCfg :: DataSetCfg +bigDataSetCfg = MkDataSetCfg + { _nSlots = 13 + , _cellSize = 2048 , _blockSize = 65536 , _nCells = 512 , _nSamples = 5 , _dataSrc = FakeData (Seed 666) } +-------------------------------------------------------------------------------- + main :: IO () main = do - let slotCfg = smallSlotCfg + let dsetCfg = smallDataSetCfg + let slotIdx = SlotIdx 3 let entropy = 1234567 :: Entropy - circomMainComponentV1 slotCfg "./json/slot_main.circom" - samplingTest slotCfg entropy "./json/input_example.json" \ No newline at end of file + circomMainComponent dsetCfg "./json/slot_main.circom" + samplingTest dsetCfg slotIdx entropy "./json/input_example.json" diff --git a/reference/haskell/src/DataSet.hs b/reference/haskell/src/DataSet.hs new file mode 100644 index 0000000..cd5c97e --- /dev/null +++ b/reference/haskell/src/DataSet.hs @@ -0,0 +1,84 @@ + +{-# LANGUAGE StrictData #-} +module DataSet where + +-------------------------------------------------------------------------------- + +import System.FilePath + +import Slot hiding ( MkSlotCfg(..) ) +import qualified Slot as Slot + +-------------------------------------------------------------------------------- + +data DataSetCfg = MkDataSetCfg + { _nSlots :: Int -- ^ number of slots per dataset + , _cellSize :: Int + , _blockSize :: Int + , _nCells :: Int + , _nSamples :: Int + , _dataSrc :: DataSource + } + deriving Show + +fieldElemsPerCell :: DataSetCfg -> Int +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 + } + +-------------------------------------------------------------------------------- + +loadDataSetCell :: DataSetCfg -> SlotIdx -> CellIdx -> IO CellData +loadDataSetCell dsetCfg slotIdx@(SlotIdx idx) cellidx + | idx < 0 = error "loadDataSetCell: negative slot index" + | idx >= _nSlots dsetCfg = error "loadDataSetCell: slot index out of range" + | otherwise = loadCellData (dataSetSlotCfg dsetCfg slotIdx) cellidx + + +loadDataSetBlock :: DataSetCfg -> SlotIdx -> BlockIdx -> IO BlockData +loadDataSetBlock dsetCfg slotIdx@(SlotIdx idx) blockidx + | idx < 0 = error "loadDataSetBlock: negative slot index" + | idx >= _nSlots dsetCfg = error "loadDataSetBlock: slot index out of range" + | otherwise = loadBlockData (dataSetSlotCfg dsetCfg slotIdx) blockidx + +-------------------------------------------------------------------------------- + +-- | Writes a @circom@ main component with the given parameters +-- +-- > template SampleAndProve( nFieldElemsPerCell, nSamples ) { ... } +-- +circomMainComponent :: DataSetCfg -> FilePath -> IO () +circomMainComponent dsetCfg circomFile = do + + let params = show (DataSet.fieldElemsPerCell dsetCfg) + ++ ", " ++ show (DataSet._nSamples dsetCfg) + + writeFile circomFile $ unlines + [ "pragma circom 2.0.0;" + , "include \"sample_cells.circom\";" + , "component main {public [entropy,dataSetRoot,slotIndex]} = SampleAndProve(" ++ params ++ ");" + ] + +-------------------------------------------------------------------------------- + +parametricSlotSeed :: Seed -> SlotIdx -> Seed +parametricSlotSeed (Seed seed) (SlotIdx k) = Seed (seed + 72 + 1001*k) + +-- | From @dir/dset.dat@ we make @dir/dset5.dat@ for the 5-th slot +parametricSlotFileName :: FilePath -> SlotIdx -> FilePath +parametricSlotFileName basefile (SlotIdx k) = + (dropExtension basefile ++ show k) <.> (takeExtension basefile) + +parametricSlotDataSource :: DataSource -> SlotIdx -> DataSource +parametricSlotDataSource src idx = case src of + FakeData seed -> FakeData (parametricSlotSeed seed idx) + SlotFile fpath -> SlotFile (parametricSlotFileName fpath idx) + +-------------------------------------------------------------------------------- diff --git a/reference/haskell/src/Sampling.hs b/reference/haskell/src/Sampling.hs index 5b32aa4..eb4504d 100644 --- a/reference/haskell/src/Sampling.hs +++ b/reference/haskell/src/Sampling.hs @@ -9,16 +9,17 @@ import System.IO import qualified Data.ByteString as B +import Slot as Slot +import DataSet as DataSet import Poseidon2 -import Slot import qualified ZK.Algebra.Curves.BN128.Fr.Mont as Fr -------------------------------------------------------------------------------- -samplingTest :: SlotConfig -> Entropy -> FilePath -> IO () -samplingTest slotCfg entropy fpath = do - input <- calculateCircuitInput slotCfg entropy +samplingTest :: DataSetCfg -> SlotIdx -> Entropy -> FilePath -> IO () +samplingTest dsetCfg slotIdx entropy fpath = do + input <- calculateCircuitInput dsetCfg slotIdx entropy exportCircuitInput fpath input -------------------------------------------------------------------------------- @@ -31,32 +32,49 @@ sampleCellIndex :: SlotConfig -> Entropy -> Hash -> Int -> CellIdx sampleCellIndex cfg entropy slotRoot counter = CellIdx (fromInteger idx) where u = sponge2 [entropy , slotRoot , fromIntegral counter] :: Fr idx = (Fr.from u) `mod` n :: Integer - n = (fromIntegral $ _nCells cfg) :: Integer + n = (fromIntegral $ Slot._nCells cfg) :: Integer -------------------------------------------------------------------------------- data CircuitInput = MkInput { _entropy :: Entropy -- ^ public input - , _slotRoot :: Hash -- ^ public input - , _cellsPerSlot :: Int -- ^ public input + , _dataSetRoot :: Hash -- ^ public input + , _slotIndex :: Int -- ^ public input + , _slotRoot :: Hash -- ^ private input + , _slotProof :: [Fr] -- ^ private input + , _slotsPerDSet :: Int -- ^ private input + , _cellsPerSlot :: Int -- ^ private input , _cellData :: [[Fr]] -- ^ private input , _merklePaths :: [[Fr]] -- ^ private input } deriving Show -- | Calculate the the inputs for the storage proof circuit -calculateCircuitInput :: SlotConfig -> Entropy -> IO CircuitInput -calculateCircuitInput slotCfg entropy = do - slotTree <- calcSlotTree slotCfg - let !slotRoot = slotTreeRoot slotTree - let !idxs = [ sampleCellIndex slotCfg entropy slotRoot j | j <- [1..(_nSamples slotCfg)] ] +calculateCircuitInput :: DataSetCfg -> SlotIdx -> Entropy -> IO CircuitInput +calculateCircuitInput dataSetCfg slotIdx@(SlotIdx sidx) entropy = do + let nslots = _nSlots dataSetCfg - cellData <- forM idxs $ \idx -> (cellDataToFieldElements <$> loadCellData slotCfg idx) - let !merklePaths = [ extractCellProof slotCfg slotTree idx | idx <- idxs ] + 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 ourSlotCfg = slotCfgs !! sidx + let ourSlotRoot = slotRoots !! sidx + let ourSlotTree = slotTrees !! sidx + let !idxs = [ sampleCellIndex ourSlotCfg entropy ourSlotRoot j | j <- [1..(Slot._nSamples ourSlotCfg)] ] + + cellData <- forM idxs $ \idx -> (cellDataToFieldElements <$> loadCellData ourSlotCfg idx) + let !merklePaths = [ extractCellProof ourSlotCfg ourSlotTree idx | idx <- idxs ] return $ MkInput { _entropy = entropy - , _slotRoot = slotRoot - , _cellsPerSlot = _nCells slotCfg + , _dataSetRoot = dsetRoot + , _slotIndex = sidx + , _slotRoot = ourSlotRoot + , _slotProof = extractMerkleProof_ dsetTree sidx + , _slotsPerDSet = nslots + , _cellsPerSlot = Slot._nCells ourSlotCfg , _cellData = cellData , _merklePaths = merklePaths } @@ -70,10 +88,15 @@ calculateCircuitInput slotCfg entropy = do exportCircuitInput :: FilePath -> CircuitInput -> IO () exportCircuitInput fpath input = do h <- openFile fpath WriteMode - hPutStrLn h $ "{ \"entropy\": " ++ show (show (_entropy input)) - hPutStrLn h $ ", \"slotRoot\": " ++ show (show (_slotRoot input)) - hPutStrLn h $ ", \"nCells\": " ++ show (show (_cellsPerSlot input)) - hPutStrLn h $ ", \"cellData\": " + hPutStrLn h $ "{ \"entropy\": " ++ show (show (_entropy input)) + hPutStrLn h $ ", \"dataSetRoot\": " ++ show (show (_dataSetRoot input)) + hPutStrLn h $ ", \"slotIndex\": " ++ show (show (_slotIndex input)) + hPutStrLn h $ ", \"slotRoot\": " ++ show (show (_slotRoot input)) + hPutStrLn h $ ", \"nSlotsPerDataSet\": " ++ show (show (_slotsPerDSet input)) + hPutStrLn h $ ", \"nCellsPerSlot\": " ++ show (show (_cellsPerSlot input)) + hPutStrLn h $ ", \"slotProof\":" + hPrintList h 4 (map show $ _slotProof input) + hPutStrLn h $ ", \"cellData\":" hPrintListOfLists h ((map.map) show $ _cellData input) hPutStrLn h $ ", \"merklePaths\": " hPrintListOfLists h ((map.map) show $ _merklePaths input) diff --git a/reference/haskell/src/Slot.hs b/reference/haskell/src/Slot.hs index 719f3d7..e319842 100644 --- a/reference/haskell/src/Slot.hs +++ b/reference/haskell/src/Slot.hs @@ -81,37 +81,19 @@ exSlotCfg = MkSlotCfg fieldElemsPerCell :: SlotConfig -> Int fieldElemsPerCell cfg = (_cellSize cfg + 30) `div` 31 --------------------------------------------------------------------------------- - --- | Writes a @circom@ main component with the given parameters --- --- > template SampleAndProveV1( nCells, nFieldElemsPerCell, nSamples ) { ... } --- -circomMainComponentV1 :: SlotConfig -> FilePath -> IO () -circomMainComponentV1 slotCfg circomFile = do - - let params = show (_nCells slotCfg) - ++ ", " ++ show (fieldElemsPerCell slotCfg) - ++ ", " ++ show (_nSamples slotCfg) - - writeFile circomFile $ unlines - [ "pragma circom 2.0.0;" - , "include \"sample_cells.circom\";" - , "component main {public [entropy,slotRoot]} = SampleAndProveV1(" ++ params ++ ");" - ] - -------------------------------------------------------------------------------- -- * load data genFakeCell :: SlotConfig -> Seed -> CellIdx -> CellData genFakeCell cfg (Seed seed) (CellIdx idx) = (mkCellData cfg $ B.pack list) where list = go (fromIntegral $ _cellSize cfg) 1 - seed1 = fromIntegral seed :: Word64 - seed2 = fromIntegral idx :: Word64 + seed1 = fromIntegral seed + 0xdeadcafe :: Word64 + seed2 = fromIntegral idx + 0x98765432 :: Word64 go :: Word64 -> Word64 -> [Word8] go 0 _ = [] - go cnt state = fromIntegral state' : go (cnt-1) state' where - state' = state*state + seed1*state + (seed2 + 17) + go cnt state = fromIntegral state'' : go (cnt-1) state'' where + state' = state*(state + seed1)*(state + seed2) + state*(state `xor` 0x5a5a5a5a) + seed1*state + (seed2 + 17) + state'' = mod state' 1698428844001831 genFakeBlock :: SlotConfig -> Seed -> BlockIdx -> BlockData genFakeBlock cfg seed (BlockIdx blockIdx) = (mkBlockData cfg $ B.concat$ map fromCellData cells) where diff --git a/reference/haskell/storage-proof-ref.cabal b/reference/haskell/storage-proof-ref.cabal index 4bff75c..f0b0605 100644 --- a/reference/haskell/storage-proof-ref.cabal +++ b/reference/haskell/storage-proof-ref.cabal @@ -31,9 +31,11 @@ Library bytestring >= 0.9 && < 2, array >= 0.5 && < 1, random >= 1.1 && < 1.5, - zikkurat-algebra == 0.0.1 + zikkurat-algebra == 0.0.1, + filepath >= 1.4 Exposed-Modules: Sampling + DataSet Slot Poseidon2 Poseidon2.Example diff --git a/reference/nim/proof_input/src/dataset.nim b/reference/nim/proof_input/src/dataset.nim new file mode 100644 index 0000000..a0f4fd7 --- /dev/null +++ b/reference/nim/proof_input/src/dataset.nim @@ -0,0 +1,56 @@ + +import sugar + +import std/streams +import std/sequtils + +import types +import blocks +import slot + +#------------------------------------------------------------------------------- +# Example slot configuration +# + +const exDataSetCfg* = + DataSetConfig( nCells: 256 # 1024 + , nSamples: 7 # 20 + , nSlots: 5 + , dataSrc: DataSource(kind: FakeData, seed: 12345) + ) + +#------------------------------------------------------------------------------- + +{.overflowChecks: off.} +func parametricSlotSeed( seed: Seed, k: SlotIdx): Seed = (seed + 72 + 1001*uint64(k)) + +func parametricSlotFileName( basefile: string, k: SlotIdx): string = basefile & ($k) & ".dat" + +func parametricSlotDataSource( src: DataSource, k: SlotIdx): DataSource = + case src.kind + of FakeData: + return DataSource(kind: FakeData, seed: parametricSlotSeed(src.seed, k)) + of SlotFile: + return DataSource(kind: SlotFile, filename: parametricSlotFileName(src.filename, k)) + +#------------------------------------------------------------------------------- + +func slotCfgFromDataSetCfg*( dsetcfg: DataSetConfig, idx: SlotIdx ): SlotConfig = + assert( idx >= 0 and idx < dsetcfg.nSlots ) + let newDataSrc = parametricSlotDataSource( dsetcfg.dataSrc, idx ) + return SlotConfig( nCells: dsetcfg.nCells + , nSamples: dsetcfg.nSamples + , dataSrc: newDataSrc + ) + +#------------------------------------------------------------------------------- + +proc dataSetLoadCellData*(dsetCfg: DataSetConfig, slotIdx: SlotIdx, cellIdx: CellIdx): Cell = + let slotCfg = slotCfgFromDataSetCfg( dsetCfg, slotIdx ) + return slotLoadCellData(slotCfg, cellIdx) + +proc dataSetLoadBlockData*(dsetCfg: DataSetConfig, slotIdx: SlotIdx, blockIdx: BlockIdx): Block = + let slotCfg = slotCfgFromDataSetCfg( dsetCfg, slotIdx ) + return slotLoadBlockData(slotCfg, blockIdx) + +#------------------------------------------------------------------------------- diff --git a/reference/nim/proof_input/src/gen_input.nim b/reference/nim/proof_input/src/gen_input.nim index 8121626..cb45d00 100644 --- a/reference/nim/proof_input/src/gen_input.nim +++ b/reference/nim/proof_input/src/gen_input.nim @@ -9,41 +9,64 @@ import std/sequtils import blocks import slot +import dataset import sample import merkle import types #------------------------------------------------------------------------------- -proc generateProofInput*( cfg: SlotConfig, entropy: Entropy ): SlotProofInput = - - let ncells = cfg.nCells +proc buildSlotTreeFull( slotCfg: SlotConfig ): (seq[MerkleTree], MerkleTree) = + let ncells = slotCfg.nCells let nblocks = ncells div cellsPerBlock - assert( nblocks * cellsPerBlock == ncells ) - - let blocks : seq[Block] = collect( newSeq, (for i in 0.. Seed -> CellIdx -> CellData -genFakeCell cfg seed idx = (mkCellData cfg $ B.pack list) where +genFakeCell cfg (Seed seed) (CellIdx idx) = (mkCellData cfg $ B.pack list) where list = go (fromIntegral $ _cellSize cfg) 1 - seed1 = fromIntegral seed :: Word64 - seed2 = fromIntegral idx :: Word64 + seed1 = fromIntegral seed + 0xdeadcafe :: Word64 + seed2 = fromIntegral idx + 0x98765432 :: Word64 go :: Word64 -> Word64 -> [Word8] go 0 _ = [] - go cnt state = fromIntegral state' : go (cnt-1) state' where - state' = state*state + seed1*state + (seed2 + 17) -]# + go cnt state = fromIntegral state'' : go (cnt-1) state'' where + state' = state*(state + seed1)*(state + seed2) + state*(state `xor` 0x5a5a5a5a) + seed1*state + (seed2 + 17) + state'' = mod state' 1698428844001831 +#] #------------------------------------------------------------------------------- -proc loadCellData*(cfg: SlotConfig, idx: CellIdx): Cell = +proc slotLoadCellData*(cfg: SlotConfig, idx: CellIdx): Cell = case cfg.dataSrc.kind of FakeData: @@ -63,9 +64,9 @@ proc loadCellData*(cfg: SlotConfig, idx: CellIdx): Cell = return arr.toSeq() -proc loadBlockData*(cfg: SlotConfig, idx: BlockIdx): Block = +proc slotLoadBlockData*(cfg: SlotConfig, idx: BlockIdx): Block = let cells : seq[seq[byte]] = - collect( newSeq , (for i in 0..