Add Sapling VK validation

Makefile

@@ -4,7 +4,7 @@ rustlib := librustzcash-wrapper/target/x86_64-unknown-linux-gnu/debug
 
 all: haskell
 
-haskell: src/Zcash.hs src/C/Zcash.chs package.yaml stack.yaml $(rustlib)/rustzcash_wrapper.h $(rustlib)/librustzcash_wrapper.a $(rustlib)/librustzcash_wrapper.so $(rustlib)/rustzcash_wrapper-uninstalled.pc
+haskell: src/HaskellZcash/Orchard.hs src/HaskellZcash/Sapling.hs src/HaskellZcash/Types.hs src/HaskellZcash/Utils.hs src/C/Zcash.chs package.yaml stack.yaml $(rustlib)/rustzcash_wrapper.h $(rustlib)/librustzcash_wrapper.a $(rustlib)/librustzcash_wrapper.so $(rustlib)/rustzcash_wrapper-uninstalled.pc
 	stack build
 
 $(rustlib)/rustzcash_wrapper.h: librustzcash-wrapper/src/lib.rs librustzcash-wrapper/Cargo.toml

librustzcash-wrapper/Cargo.toml

@@ -14,6 +14,8 @@ borsh = "0.10"
 bech32 = "0.9.1"
 orchard = "0.4.0"
 zcash_note_encryption = "0.3.0"
+zcash_primitives = "0.12.0"
+zcash_client_backend = "0.9.0"
 
 [features]
 capi = []

librustzcash-wrapper/src/lib.rs

@@ -16,12 +16,16 @@ use haskell_ffi::{
     FromHaskell, HaskellSize, ToHaskell
 };
 
+use zcash_primitives::{sapling::keys::FullViewingKey as SaplingViewingKey, zip32::DiversifiableFullViewingKey};
+
 use zcash_address::{
     Network,
     unified::{Address, Encoding, Ufvk, Container, Fvk},
     ZcashAddress
 };
 
+use zcash_client_backend::keys::sapling::ExtendedFullViewingKey;
+
 use orchard::{
     Action,
     keys::{FullViewingKey, PreparedIncomingViewingKey, Scope},
@@ -35,7 +39,10 @@ use zcash_note_encryption;
 
 use bech32::{
     decode,
-    u5
+    u5,
+    FromBase32,
+    ToBase32,
+    Variant
 };
 
 pub enum RW {}
@@ -124,6 +131,19 @@ impl Hufvk {
     }
 }
 
+#[derive(BorshSerialize, BorshDeserialize)]
+pub struct Hsvk {
+    vk: Vec<u8>,
+    ovk: Vec<u8>
+}
+
+impl<RW> ToHaskell<RW> for Hsvk {
+    fn to_haskell<W: Write>(&self, writer: &mut W, _tag: PhantomData<RW>) -> Result<()> {
+        self.serialize(writer)?;
+        Ok(())
+    }
+}
+
 fn to_array<T, const N: usize>(v: Vec<T>) -> [T; N] {
     v.try_into().unwrap_or_else(|v: Vec<T>| panic!("Expected a Vec of length {} but it was {}", N, v.len()))
 }
@@ -175,9 +195,36 @@ pub extern "C" fn rust_wrapper_bech32decode(
     out_len: &mut usize
     ) {
     let input: String = marshall_from_haskell_var(input, input_len, RW);
-    let (hrp, bytes) = bech32::decode_without_checksum(&input).unwrap();
-    let rd = RawData {hrp: hrp.into(), bytes: bytes.iter().map(|&x| bech32::u5::to_u8(x)).collect()};
-    marshall_to_haskell_var(&rd, out, out_len, RW);
+    let (hrp, bytes, variant) = bech32::decode(&input).unwrap();
+    let decodedBytes = bech32::decode(&input);
+    match decodedBytes {
+        Ok((hrp, bytes, variant)) => {
+            let rd = RawData {hrp: hrp.into(), bytes: Vec::<u8>::from_base32(&bytes).unwrap()};
+            marshall_to_haskell_var(&rd, out, out_len, RW);
+        }
+        Err(_e) => {
+            let rd1 = RawData {hrp: "fail".into(), bytes: vec![0]};
+            marshall_to_haskell_var(&rd1, out, out_len, RW);
+        }
+    }
+}
+
+#[no_mangle]
+pub extern "C" fn rust_wrapper_svk_decode(
+    input: *const u8,
+    input_len: usize
+    ) -> bool {
+    let input: Vec<u8> = marshall_from_haskell_var(input, input_len, RW);
+    let svk = ExtendedFullViewingKey::read(&*input);
+    match svk {
+        Ok(k) => {
+            true
+        }
+        Err(e) => {
+            print!("{}", e);
+            false
+        }
+    }
 }
 
 #[no_mangle]

src/C/Zcash.chs

@@ -59,6 +59,12 @@ import HaskellZcash.Types
   -> `()'
 #}
 
+{# fun pure unsafe rust_wrapper_svk_decode as rustWrapperSaplingVkDecode
+     { toBorshVar* `BS.ByteString'&
+     }
+  -> `Bool'
+#}
+
 {# fun unsafe rust_wrapper_ufvk_decode as rustWrapperUfvkDecode
      { toBorshVar* `BS.ByteString'&
      , getVarBuffer `Buffer UnifiedFullViewingKey'&

src/HaskellZcash/Sapling.hs

@@ -1,8 +1,12 @@
 module HaskellZcash.Sapling where
 
-import C.Zcash (rustWrapperIsShielded)
+import C.Zcash (rustWrapperIsShielded, rustWrapperSaplingVkDecode)
 import qualified Data.ByteString as BS
 
 -- | Check if given bytesting is a valid encoded shielded address
 isValidShieldedAddress :: BS.ByteString -> Bool
 isValidShieldedAddress = rustWrapperIsShielded
+
+-- | Check if given bytestring is a valid Sapling viewing key
+isValidSaplingViewingKey :: BS.ByteString -> Bool
+isValidSaplingViewingKey = rustWrapperSaplingVkDecode

test/Spec.hs

@@ -5,6 +5,7 @@ import qualified Data.ByteString as BS
 import qualified Data.Text.Encoding as E
 import Data.Word
 import HaskellZcash.Orchard
+import HaskellZcash.Sapling (isValidSaplingViewingKey, isValidShieldedAddress)
 import HaskellZcash.Types
   ( OrchardAction(..)
   , OrchardDecodedAction(..)
@@ -17,6 +18,12 @@ import Test.Hspec
 main :: IO ()
 main = do
   hspec $ do
+    describe "Bech32" $ do
+      let s = "bech321qqqsyrhqy2a"
+      let decodedString = decodeBech32 s
+      it "hrp matches" $ do hrp decodedString `shouldBe` "bech32"
+      it "data matches" $ do
+        bytes decodedString `shouldBe` BS.pack ([0x00, 0x01, 0x02] :: [Word8])
     describe "F4Jumble" $ do
       it "jumble a string" $ do
         let input =
@@ -222,6 +229,29 @@ main = do
               , 0x22
               ] :: [Word8]
         f4UnJumble (BS.pack out) `shouldBe` BS.pack input
+    describe "Sapling address" $ do
+      it "succeeds with valid address" $ do
+        let sa =
+              "zs17faa6l5ma55s55exq9rnr32tu0wl8nmqg7xp3e6tz0m5ajn2a6yxlc09t03mqdmvyphavvf3sl8"
+        isValidShieldedAddress sa `shouldBe` True
+      it "fails with invalid address" $ do
+        let sa =
+              "zs17faa6l5ma55s55exq9rnr32tu0wl8nmqg7xp3e6tz0m5ajn2a6yxlc09t03mqdmvyphavvffake"
+        isValidShieldedAddress sa `shouldBe` False
+    describe "Decode Sapling VK" $ do
+      let vk =
+            "zxviews1qdjagrrpqqqqpq8es75mlu6rref0qyrstchf8dxzeygtsejwfqu8ckhwl2qj5m8am7lmupxk3vkvdjm8pawjpmesjfapvsqw96pa46c2z0kk7letrxf7mkltwz54fwpxc7kc79mm5kce3rwn5ssl009zwsra2spppwgrx25s9k5hq65f69l4jz2tjmqgy0pl49qmtaj3nudk6wglwe2hpa327hydlchtyq9av6wjd6hu68e04ahwk9a9n2kt0kj3nj99nue65awtu5cwwcpjs"
+      let sa =
+            "zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
+      let rawKey = decodeBech32 vk
+      it "is mainnet" $ do hrp rawKey `shouldBe` "zxviews"
+      it "is valid Sapling raw key" $ do
+        isValidSaplingViewingKey (bytes rawKey) `shouldBe` True
+    describe "Decode invalid Sapling VK" $ do
+      let vk =
+            "zxviews1qdjagrrpqqqqpq8es75mlu6rref0qyrstchf8dxzeygtsejwfqu8ckhwl2qj5m8am7lmupxk3vkvdjm8pawjpmesjfapvsqw96pa46c2z0kk7letrxf7mkltwz54fwpxc7kc79mm5kce3rwn5ssl009zwsra2spppwgrx25s9k5hq65f69l4jz2tjmqgy0pl49qmtaj3nudk6wglwe2hpa327hydlchtyq9av6wjd6hu68e04ahwk9a9n2kt0kj3nj99nue65awtu5cwwfake"
+      let rawKey = decodeBech32 vk
+      it "is not mainnet" $ do hrp rawKey `shouldBe` "fail"
     describe "Unified address" $ do
       it "succeeds with correct UA" $ do
         let ua =