Add Sapling commitment tree functionality

CHANGELOG.md

@@ -5,8 +5,15 @@ All notable changes to this project will be documented in this file.
 The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
 and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).
 
+## [0.5.4.1]
+
+### Added
+
+- Functions to handle Sapling commitment trees, incremental witnesses and note positions
+
 ## [0.5.4.0]
 
+### Added
 - Function to decode Orchard actions with a spending key
 - Functions for Bech32 encoding
 - Function to encode a Sapling address

librustzcash-wrapper/src/lib.rs

@@ -24,14 +24,19 @@ use haskell_ffi::{
     FromHaskell, HaskellSize, ToHaskell
 };
 
-use incrementalmerkletree::frontier::CommitmentTree;
+use incrementalmerkletree::{
+    frontier::CommitmentTree,
+    witness::IncrementalWitness
+};
 
 use zip32;
 
 use zcash_primitives::{
     merkle_tree::{
         read_commitment_tree,
-        write_commitment_tree
+        write_commitment_tree,
+        read_incremental_witness,
+        write_incremental_witness
     },
     zip32::{
         Scope as SaplingScope,
@@ -1146,7 +1151,23 @@ pub extern "C" fn rust_wrapper_derive_orchard_receiver(
 }
 
 #[no_mangle]
-pub extern "C" fn rust_wrapper_read_commitment_tree(
+pub extern "C" fn rust_wrapper_bech32_encode(
+    hr: *const u8,
+    hr_len: usize,
+    b: *const u8,
+    b_len: usize,
+    out: *mut u8,
+    out_len: &mut usize
+    ) {
+    let hr: String = marshall_from_haskell_var(hr, hr_len, RW);
+    let hrp = Hrp::parse(&hr).unwrap();
+    let b: Vec<u8> = marshall_from_haskell_var(b, b_len, RW);
+    let string = bech32::encode::<Bech32>(hrp, &b).unwrap();
+    marshall_to_haskell_var(&string, out, out_len, RW);
+}
+
+#[no_mangle]
+pub extern "C" fn rust_wrapper_read_sapling_commitment_tree(
     tree: *const u8,
     tree_len: usize,
     node: *const u8,
@@ -1176,18 +1197,46 @@ pub extern "C" fn rust_wrapper_read_commitment_tree(
 }
 
 #[no_mangle]
-pub extern "C" fn rust_wrapper_bech32_encode(
-    hr: *const u8,
-    hr_len: usize,
-    b: *const u8,
-    b_len: usize,
+pub extern "C" fn rust_wrapper_read_sapling_witness(
+    tree: *const u8,
+    tree_len: usize,
     out: *mut u8,
     out_len: &mut usize
     ){
-    let hr: String = marshall_from_haskell_var(hr, hr_len, RW);
-    let hrp = Hrp::parse(&hr).unwrap();
-    let b: Vec<u8> = marshall_from_haskell_var(b, b_len, RW);
-    let string = bech32::encode::<Bech32>(hrp, &b).unwrap();
-    marshall_to_haskell_var(&string, out, out_len, RW);
+    let tree_in: Vec<u8> = marshall_from_haskell_var(tree, tree_len, RW);
+    let tree_reader = Cursor::new(tree_in);
+    let ct: CommitmentTree<Node, SAPLING_DEPTH> = read_commitment_tree(tree_reader).unwrap();
+    let inc_wit = IncrementalWitness::from_tree(ct);
+    let mut out_bytes: Vec<u8> = Vec::new();
+    let result = write_incremental_witness(&inc_wit, &mut out_bytes);
+    match result {
+        Ok(()) => {
+            let h = Hhex { bytes: out_bytes};
+            marshall_to_haskell_var(&h, out, out_len, RW);
+        },
+        Err(_e) => {
+            let h0 = Hhex { bytes: vec![0]};
+            marshall_to_haskell_var(&h0, out, out_len, RW);
+        }
+    }
 }
 
+#[no_mangle]
+pub extern "C" fn rust_wrapper_read_sapling_position(
+    wit: *const u8,
+    wit_len: usize,
+    ) -> u64 {
+    let wit_in: Vec<u8> = marshall_from_haskell_var(wit, wit_len, RW);
+    let wit_reader = Cursor::new(wit_in);
+    let iw: IncrementalWitness<Node, SAPLING_DEPTH> = read_incremental_witness(wit_reader).unwrap();
+    let path = iw.path();
+    match path {
+        Some(p) => {
+            let pos = p.position();
+            return u64::from(pos);
+        },
+        None => {
+            return 0;
+        }
+    }
+}

src/C/Zcash.chs

@@ -21,6 +21,7 @@ import qualified Data.Text as T
 import Data.Word
 import Data.Int
 import Data.Structured
+import Data.HexString (HexString(..))
 import Foreign.C.Types
 import Foreign.Rust.Marshall.External
 import Foreign.Rust.Marshall.Fixed
@@ -201,14 +202,27 @@ import ZcashHaskell.Types
   -> `()'
 #}
 
-{# fun unsafe rust_wrapper_read_commitment_tree as rustWrapperReadSaplingCommitmentTree
+{# fun unsafe rust_wrapper_read_sapling_commitment_tree as rustWrapperReadSaplingCommitmentTree
      { toBorshVar* `BS.ByteString'&
      , toBorshVar* `BS.ByteString'&
-     , getVarBuffer `Buffer (BS.ByteString)'&
+     , getVarBuffer `Buffer HexString'&
      }
   -> `()'
 #}
 
+{# fun unsafe rust_wrapper_read_sapling_witness as rustWrapperReadSaplingWitness
+     { toBorshVar* `BS.ByteString'&
+     , getVarBuffer `Buffer HexString'&
+     }
+  -> `()'
+#}
+
+{# fun pure unsafe rust_wrapper_read_sapling_position as rustWrapperReadSaplingPosition
+     { toBorshVar* `BS.ByteString'&
+     }
+  -> `Word64'
+#}
+
 {# fun unsafe rust_wrapper_bech32_encode as rustWrapperBech32Encode
      { toBorshVar* `BS.ByteString'&
      , toBorshVar* `BS.ByteString'&
@@ -216,3 +230,4 @@ import ZcashHaskell.Types
      }
   -> `()'
 #}
+

src/ZcashHaskell/Sapling.hs

@@ -20,6 +20,8 @@ module ZcashHaskell.Sapling where
 import C.Zcash
   ( rustWrapperIsShielded
   , rustWrapperReadSaplingCommitmentTree
+  , rustWrapperReadSaplingPosition
+  , rustWrapperReadSaplingWitness
   , rustWrapperSaplingCheck
   , rustWrapperSaplingChgPaymentAddress
   , rustWrapperSaplingDecodeEsk
@@ -43,8 +45,10 @@ import ZcashHaskell.Types
   , DecodedNote(..)
   , RawData(..)
   , RawTxResponse(..)
+  , SaplingCommitmentTree(..)
   , SaplingReceiver(..)
   , SaplingSpendingKey(..)
+  , SaplingWitness(..)
   , Scope(..)
   , Seed(..)
   , ShieldedOutput(..)
@@ -170,14 +174,32 @@ genSaplingInternalAddress sk =
 
 -- | Update a Sapling commitment tree
 updateSaplingCommitmentTree ::
-     HexString -- ^ the base tree
+     SaplingCommitmentTree -- ^ the base tree
   -> HexString -- ^ the new note commitment
-  -> Maybe HexString
+  -> Maybe SaplingCommitmentTree
 updateSaplingCommitmentTree tree cmu =
-  if BS.length updatedTree > 1
-    then Just $ HexString updatedTree
+  if BS.length (hexBytes updatedTree) > 1
+    then Just $ SaplingCommitmentTree updatedTree
     else Nothing
   where
     updatedTree =
       withPureBorshVarBuffer $
-      rustWrapperReadSaplingCommitmentTree (hexBytes tree) (hexBytes cmu)
+      rustWrapperReadSaplingCommitmentTree
+        (hexBytes $ sapTree tree)
+        (hexBytes cmu)
+
+-- | Get the Sapling incremental witness from a commitment tree
+getSaplingWitness :: SaplingCommitmentTree -> Maybe SaplingWitness
+getSaplingWitness tree =
+  if BS.length (hexBytes wit) > 1
+    then Just $ SaplingWitness wit
+    else Nothing
+  where
+    wit =
+      withPureBorshVarBuffer $
+      rustWrapperReadSaplingWitness (hexBytes $ sapTree tree)
+
+-- | Get the Sapling note position from a witness
+getSaplingNotePosition :: SaplingWitness -> Integer
+getSaplingNotePosition =
+  fromIntegral . rustWrapperReadSaplingPosition . hexBytes . sapWit

src/ZcashHaskell/Types.hs

@@ -519,6 +519,16 @@ instance FromJSON ShieldedOutput where
       p <- obj .: "proof"
       pure $ ShieldedOutput cv cmu ephKey encText outText p
 
+-- | Type for a Sapling note commitment tree
+newtype SaplingCommitmentTree = SaplingCommitmentTree
+  { sapTree :: HexString
+  } deriving (Eq, Prelude.Show, Read)
+
+-- | Type for a Sapling incremental witness
+newtype SaplingWitness = SaplingWitness
+  { sapWit :: HexString
+  } deriving (Eq, Prelude.Show, Read)
+
 -- * Orchard
 -- | A spending key for Orchard
 newtype OrchardSpendingKey =

test/Spec.hs

@@ -50,6 +50,8 @@ import ZcashHaskell.Sapling
   , genSaplingInternalAddress
   , genSaplingPaymentAddress
   , genSaplingSpendingKey
+  , getSaplingNotePosition
+  , getSaplingWitness
   , getShieldedOutputs
   , isValidSaplingViewingKey
   , isValidShieldedAddress
@@ -72,6 +74,7 @@ import ZcashHaskell.Types
   , RawTxOut(..)
   , RawTxResponse(..)
   , RawZebraTx(..)
+  , SaplingCommitmentTree(..)
   , SaplingReceiver(..)
   , SaplingSpendingKey(..)
   , Scope(..)
@@ -843,10 +846,10 @@ main = do
             Nothing -> assertFailure "Couldn't decode"
             Just t' -> do
               let tb = zt_tBundle t'
-              print tb
               show tb `shouldNotBe` ""
       describe "Sapling commitment trees" $ do
         let tree =
+              SaplingCommitmentTree $
               hexString
                 "01916df07670600aefa3b412a120d6b8d9a3d2ff9466a7ec770cd52d34ddb42313001000013c60b031a5e44650059fcc7101a3f551b807ab8b3a116a5a9c7fa0f3babbe735017c0d36686294ff19d59e58b6a2ac6a7ad607a804bc202c84012d8e94f233970c0128dbde5180af5304d8577376d78297130b615a327974c10881f6d876869aea05011b80b4ca60f74dfe33c78b062df73c84b8b44dab4604db16f5b61eea40134373010c96e4cc8a6a80fba0d41e4eb3070d80769104dc33fb61133b1304c15bf9e23e000107114fe4bb4cd08b47f6ae47477c182d5da9fe5c189061808c1091e9bf3b4524000001447d6b9100cddd5f80c8cf4ddee2b87eba053bd987465aec2293bd0514e68b0d015f6c95e75f4601a0a31670a7deb970fc8988c611685161d2e1629d0a1a0ebd07015f8b9205e0514fa235d75c150b87e23866b882b39786852d1ab42aab11d31a4a0117ddeb3a5f8d2f6b2d0a07f28f01ab25e03a05a9319275bb86d72fcaef6fc01501f08f39275112dd8905b854170b7f247cf2df18454d4fa94e6e4f9320cca05f24011f8322ef806eb2430dc4a7a41c1b344bea5be946efc7b4349c1c9edb14ff9d39"
         let cmu1 =
@@ -859,10 +862,18 @@ main = do
               hexString
                 "01a47029e9b43722c57143a5d07681bff3e2315c9a28ad49d69e7c1f2f6e81ac160010000000000000012f4f72c03f8c937a94919a01a07f21165cc8394295291cb888ca91ed003810390107114fe4bb4cd08b47f6ae47477c182d5da9fe5c189061808c1091e9bf3b4524000001447d6b9100cddd5f80c8cf4ddee2b87eba053bd987465aec2293bd0514e68b0d015f6c95e75f4601a0a31670a7deb970fc8988c611685161d2e1629d0a1a0ebd07015f8b9205e0514fa235d75c150b87e23866b882b39786852d1ab42aab11d31a4a0117ddeb3a5f8d2f6b2d0a07f28f01ab25e03a05a9319275bb86d72fcaef6fc01501f08f39275112dd8905b854170b7f247cf2df18454d4fa94e6e4f9320cca05f24011f8322ef806eb2430dc4a7a41c1b344bea5be946efc7b4349c1c9edb14ff9d39"
         it "Commitment tree is updated correctly" $ do
+          let t1 = updateSaplingCommitmentTree tree cmu1
+          t1 `shouldNotBe` Nothing
+        it "Incremental witness is generated" $ do
           let t1 = updateSaplingCommitmentTree tree cmu1
           case t1 of
-            Nothing -> assertFailure "Tree 1 failed"
-            Just t2 -> updateSaplingCommitmentTree t2 cmu2 `shouldBe` Just tree2
+            Nothing -> assertFailure "Failed to append node to tree"
+            Just t -> getSaplingWitness t `shouldNotBe` Nothing
+        it "Position of note is obtained" $ do
+          let p =
+                getSaplingNotePosition <$>
+                (getSaplingWitness =<< updateSaplingCommitmentTree tree cmu1)
+          p `shouldBe` Just 129405
       describe "Extract Sapling Address - UA Valid" $ do
         let sr =
               getSaplingFromUA

zcash-haskell.cabal

@@ -5,7 +5,7 @@ cabal-version: 3.0
 -- see: https://github.com/sol/hpack
 
 name:           zcash-haskell
-version:        0.5.4.0
+version:        0.5.4.1
 synopsis:       Utilities to interact with the Zcash blockchain
 description:    Please see the README on the repo at <https://git.vergara.tech/Vergara_Tech/zcash-haskell#readme>
 category:       Blockchain