Vergara_Tech/zenith
Vergara_Tech/zenith
2
0
Fork 0
Code Issues 21 Pull requests Projects Releases 6 Packages Wiki Activity

RPC Server #103

Merged
pitmutt merged 129 commits from rav001 into milestone3 2024-11-21 15:30:22 +00:00
Conversation 0 Commits 129 Files changed 22 +77 -22
2 changed files with 77 additions and 22 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files
Showing only changes of commit a7cf3a75c6 - Show all commits

37
src/Zenith/Tree.hs
View file

@ -10,7 +10,7 @@ module Zenith.Tree where
import Codec.Borsh import Codec.Borsh
import Data.HexString import Data.HexString
import Data.Int (Int64, Int8) import Data.Int (Int32, Int64, Int8)
import Data.Maybe (fromJust, isNothing) import Data.Maybe (fromJust, isNothing)
import qualified GHC.Generics as GHC import qualified GHC.Generics as GHC
import qualified Generics.SOP as SOP import qualified Generics.SOP as SOP
@ -22,7 +22,7 @@ type Level = Int8
maxLevel :: Level maxLevel :: Level
maxLevel = 32 maxLevel = 32
type Position = Int64 type Position = Int32
class Monoid v => class Monoid v =>
Measured a v Measured a v
@ -31,7 +31,7 @@ class Monoid v =>
class Node v where class Node v where
getLevel :: v -> Level getLevel :: v -> Level
getTag :: v -> HexString getHash :: v -> HexString
getPosition :: v -> Position getPosition :: v -> Position
isFull :: v -> Bool isFull :: v -> Bool
isMarked :: v -> Bool isMarked :: v -> Bool
@ -60,7 +60,7 @@ instance (Node v, Show v) => Show (Tree v) where
show (Leaf v) = "(" ++ show v ++ ")" show (Leaf v) = "(" ++ show v ++ ")"
show (PrunedBranch v) = "{" ++ show v ++ "}" show (PrunedBranch v) = "{" ++ show v ++ "}"
show (Branch s x y) = show (Branch s x y) =
"<" ++ show (getTag s) ++ ">\n" ++ show x ++ "\n" ++ show y "<" ++ show (getHash s) ++ ">\n" ++ show x ++ "\n" ++ show y
show InvalidTree = "InvalidTree" show InvalidTree = "InvalidTree"
instance (Monoid v, Node v) => Semigroup (Tree v) where instance (Monoid v, Node v) => Semigroup (Tree v) where
@ -105,7 +105,7 @@ value InvalidTree = mempty
branch :: Monoid v => Tree v -> Tree v -> Tree v branch :: Monoid v => Tree v -> Tree v -> Tree v
branch x y = Branch (value x <> value y) x y branch x y = Branch (value x <> value y) x y
leaf :: Measured a v => a -> Int64 -> Int64 -> Tree v leaf :: Measured a v => a -> Int32 -> Int64 -> Tree v
leaf a p i = Leaf (measure a p i) leaf a p i = Leaf (measure a p i)
prunedBranch :: Monoid v => Node v => Level -> Position -> HexString -> Tree v prunedBranch :: Monoid v => Node v => Level -> Position -> HexString -> Tree v
@ -120,8 +120,8 @@ root tree =
getEmptyRoot :: Monoid v => Node v => Level -> Tree v getEmptyRoot :: Monoid v => Node v => Level -> Tree v
getEmptyRoot level = iterate (\x -> x <> x) EmptyLeaf !! fromIntegral level getEmptyRoot level = iterate (\x -> x <> x) EmptyLeaf !! fromIntegral level
append :: Monoid v => Measured a v => Node v => Tree v -> a -> Int64 -> Tree v append :: Monoid v => Measured a v => Node v => Tree v -> (a, Int64) -> Tree v
append tree n i = tree <> leaf n p i append tree (n, i) = tree <> leaf n p i
where where
p = 1 + getPosition (value tree) p = 1 + getPosition (value tree)
@ -133,10 +133,23 @@ mkSubTree level t =
where where
subtree = t <> EmptyLeaf subtree = t <> EmptyLeaf
path :: Position -> Tree v -> Maybe MerklePath path :: Monoid v => Node v => Position -> Tree v -> Maybe MerklePath
path pos (Branch s x y) = undefined path pos (Branch s x y) =
if length (collectPath (Branch s x y)) /= 32
then Nothing
else Just $ MerklePath pos $ collectPath (Branch s x y)
where where
collectPath t = undefined collectPath :: Monoid v => Node v => Tree v -> [HexString]
collectPath EmptyLeaf = []
collectPath Leaf {} = []
collectPath PrunedBranch {} = []
collectPath InvalidTree = []
collectPath (Branch _ j k)
| getPosition (value k) /= 0 && getPosition (value k) < pos = []
| getPosition (value j) < pos = collectPath k <> [getHash (value j)]
| getPosition (value j) >= pos = collectPath j <> [getHash (value k)]
| otherwise = []
path _ _ = Nothing
data OrchardNode = OrchardNode data OrchardNode = OrchardNode
{ on_position :: !Position { on_position :: !Position
@ -171,7 +184,7 @@ instance Monoid OrchardNode where
instance Node OrchardNode where instance Node OrchardNode where
getLevel = on_level getLevel = on_level
getTag = on_value getHash = on_value
getPosition = on_position getPosition = on_position
isFull = on_full isFull = on_full
isMarked = on_mark isMarked = on_mark
@ -214,4 +227,4 @@ mkOrchardTree tree =
case ot_right tree of case ot_right tree of
Just r' -> leaf (fromJust $ ot_left tree) (pos - 1) 0 <> leaf r' pos 0 Just r' -> leaf (fromJust $ ot_left tree) (pos - 1) 0 <> leaf r' pos 0
Nothing -> leaf (fromJust $ ot_left tree) pos 0 <> EmptyLeaf Nothing -> leaf (fromJust $ ot_left tree) pos 0 <> EmptyLeaf
pos = orchardSize tree - 1 pos = fromIntegral $ orchardSize tree - 1

62
test/Spec.hs
View file

@ -12,12 +12,13 @@ import qualified Data.Text.Encoding as E
import Database.Persist import Database.Persist
import Database.Persist.Sqlite import Database.Persist.Sqlite
import System.Directory import System.Directory
import Test.HUnit import Test.HUnit hiding (State(..))
import Test.Hspec import Test.Hspec
import ZcashHaskell.Orchard import ZcashHaskell.Orchard
( addOrchardNodeGetRoot ( addOrchardNodeGetRoot
, getOrchardFrontier , getOrchardFrontier
, getOrchardNodeValue , getOrchardNodeValue
, getOrchardPathAnchor
, getOrchardRootTest , getOrchardRootTest
, getOrchardTreeAnchor , getOrchardTreeAnchor
, getOrchardTreeParts , getOrchardTreeParts
@ -38,6 +39,7 @@ import ZcashHaskell.Transparent
) )
import ZcashHaskell.Types import ZcashHaskell.Types
( DecodedNote(..) ( DecodedNote(..)
, MerklePath(..)
, OrchardCommitmentTree(..) , OrchardCommitmentTree(..)
, OrchardFrontier(..) , OrchardFrontier(..)
, OrchardSpendingKey(..) , OrchardSpendingKey(..)
@ -237,16 +239,16 @@ main = do
let t = leaf cmx1 0 0 <> EmptyLeaf :: Tree OrchardNode let t = leaf cmx1 0 0 <> EmptyLeaf :: Tree OrchardNode
getLevel (value t) `shouldBe` 1 getLevel (value t) `shouldBe` 1
it "Create minimal empty tree" $ do it "Create minimal empty tree" $ do
getTag (value t0) `shouldNotBe` hexString "00" getHash (value t0) `shouldNotBe` hexString "00"
it "Expand empty tree" $ do t1 `shouldBe` t1a it "Expand empty tree" $ do t1 `shouldBe` t1a
it "Create empty tree non-rec" $ getEmptyRoot 2 `shouldBe` t1 it "Create empty tree non-rec" $ getEmptyRoot 2 `shouldBe` t1
it "Validate empty tree" $ do it "Validate empty tree" $ do
getTag (value (getEmptyRoot 32 :: Tree OrchardNode)) `shouldBe` getHash (value (getEmptyRoot 32 :: Tree OrchardNode)) `shouldBe`
getOrchardRootTest 32 getOrchardRootTest 32
it "Validate tree with one leaf" $ do it "Validate tree with one leaf" $ do
let n = leaf cmx1 0 1 :: Tree OrchardNode let n = leaf cmx1 0 1 :: Tree OrchardNode
let n1 = root n let n1 = root n
getTag (value n1) `shouldBe` addOrchardNodeGetRoot 32 (hexBytes cmx1) getHash (value n1) `shouldBe` addOrchardNodeGetRoot 32 (hexBytes cmx1)
it "Validate size of tree from Zebra" $ do it "Validate size of tree from Zebra" $ do
let tree = let tree =
OrchardCommitmentTree $ OrchardCommitmentTree $
@ -289,7 +291,7 @@ main = do
let newTree = mkOrchardTree t1 let newTree = mkOrchardTree t1
let ctAnchor = getOrchardTreeAnchor tree let ctAnchor = getOrchardTreeAnchor tree
{- {-
-getTag (value newTree) `shouldBe` ctAnchor -getHash (value newTree) `shouldBe` ctAnchor
-isFull (value newTree) `shouldBe` False -isFull (value newTree) `shouldBe` False
-} -}
getPosition (value newTree) `shouldBe` 39733 getPosition (value newTree) `shouldBe` 39733
@ -318,12 +320,12 @@ main = do
Nothing -> assertFailure "Failed to get tree parts" Nothing -> assertFailure "Failed to get tree parts"
Just t1 -> do Just t1 -> do
let newTree = mkOrchardTree t1 let newTree = mkOrchardTree t1
let updatedTree1 = append newTree cmx1 4 let updatedTree1 = append newTree (cmx1, 4)
let updatedTree2 = append updatedTree1 cmx2 5 let updatedTree2 = append updatedTree1 (cmx2, 5)
let updatedTree3 = append updatedTree2 cmx3 6 let updatedTree3 = append updatedTree2 (cmx3, 6)
let updatedTree4 = append updatedTree3 cmx4 7 let updatedTree4 = append updatedTree3 (cmx4, 7)
let finalAnchor = getOrchardTreeAnchor finalTree let finalAnchor = getOrchardTreeAnchor finalTree
getTag (value updatedTree4) `shouldBe` finalAnchor getHash (value updatedTree4) `shouldBe` finalAnchor
it "Validate serializing tree to bytes" $ do it "Validate serializing tree to bytes" $ do
let tree = let tree =
OrchardCommitmentTree $ OrchardCommitmentTree $
@ -345,6 +347,46 @@ main = do
let treeBytes = serialiseBorsh t1 let treeBytes = serialiseBorsh t1
let rebuiltTree = deserialiseBorsh treeBytes let rebuiltTree = deserialiseBorsh treeBytes
rebuiltTree `shouldBe` Right t1 rebuiltTree `shouldBe` Right t1
it "Create merkle path" $ do
let tree =
OrchardCommitmentTree $
hexString
"0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000"
let cmx1 =
hexString
"1712ead46028d4349e234abf59e94e0640fe7a0829e2e2e17e1a931631810400" :: OrchardCommitment
let cmx2 =
hexString
"39f5ad39817fb432fa07c5feb3a957189fbe7662a4b5555ca95093b6d853cf07" :: OrchardCommitment
case getOrchardTreeParts tree of
Nothing -> assertFailure "Failed to get tree parts"
Just t1 -> do
let newTree = mkOrchardTree t1
let updatedTree = foldl append newTree [(cmx1, 4), (cmx2, 5)]
case path 39735 updatedTree of
Nothing -> assertFailure "Failed to get Merkle path"
Just p1 -> p1 `shouldNotBe` MerklePath 0 []
it "Validate merkle path" $ do
let tree =
OrchardCommitmentTree $
hexString
"0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000"
let cmx1 =
hexString
"1712ead46028d4349e234abf59e94e0640fe7a0829e2e2e17e1a931631810400" :: OrchardCommitment
let cmx2 =
hexString
"39f5ad39817fb432fa07c5feb3a957189fbe7662a4b5555ca95093b6d853cf07" :: OrchardCommitment
case getOrchardTreeParts tree of
Nothing -> assertFailure "Failed to get tree parts"
Just t1 -> do
let newTree = mkOrchardTree t1
let updatedTree = foldl append newTree [(cmx1, 4), (cmx2, 5)]
case path 39735 updatedTree of
Nothing -> assertFailure "Failed to get Merkle path"
Just p1 -> do
getOrchardPathAnchor cmx2 p1 `shouldBe`
getHash (value updatedTree)
describe "Creating Tx" $ do describe "Creating Tx" $ do
describe "Full" $ do describe "Full" $ do
it "To Orchard" $ do it "To Orchard" $ do