Merge pull request 'Sapling Spending keys and receivers' (#27) from rvv040 into dev040

Reviewed-on: #27

CHANGELOG.md

@@ -19,6 +19,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 - Constants for Zcash protocol
 - Types for Spending Keys and Receivers for Sapling and Orchard
 - Function to generate an Orchard receiver
+- Function to generate a Sapling receiver
 
 ### Changed
 

librustzcash-wrapper/src/lib.rs

@@ -2,7 +2,6 @@
 //
 // This file is part of Zcash-Haskell.
 //
-
 use std::{
     marker::PhantomData,
     io::{
@@ -25,15 +24,23 @@ use haskell_ffi::{
 use zip32;
 
 use zcash_primitives::{
-    zip32::Scope as SaplingScope,
+    zip32::{
+        Scope as SaplingScope,
+        sapling_find_address,
+        sapling::DiversifierKey
+    },
     zip339::{Count, Mnemonic},
     transaction::components::sapling::{
         GrothProofBytes,
-        OutputDescription,
+        OutputDescription
     },
     sapling::{
         PaymentAddress,
-        keys::PreparedIncomingViewingKey as SaplingPreparedIncomingViewingKey,
+        keys::{
+            PreparedIncomingViewingKey as SaplingPreparedIncomingViewingKey,
+            ExpandedSpendingKey,
+            FullViewingKey as SaplingFullViewingKey
+        },
         note_encryption::SaplingDomain
     },
     transaction::Transaction,
@@ -50,7 +57,12 @@ use zcash_address::{
     ZcashAddress
 };
 
-use zcash_client_backend::keys::sapling::ExtendedFullViewingKey;
+use zcash_client_backend::keys::sapling::{
+    ExtendedFullViewingKey,
+    ExtendedSpendingKey
+};
+
+use zcash_primitives::zip32::{ AccountId, DiversifierIndex };
 
 use orchard::{
     Action,
@@ -612,6 +624,51 @@ pub extern "C" fn rust_wrapper_recover_seed(
     }
 }
 
+#[no_mangle]
+pub extern "C" fn rust_wrapper_sapling_spendingkey(
+    iseed: *const u8,
+    iseed_len: usize,
+    out: *mut u8,
+    out_len: &mut usize
+    ){
+    let seed: Vec<u8> = marshall_from_haskell_var(iseed, iseed_len, RW);
+    if  ( seed.len() != 64 ) {
+        // invalid seed length 
+        marshall_to_haskell_var(&vec![0], out, out_len, RW);
+    } else {
+        // Obtain the ExtendedSpendingKey using the seed
+        // Returns a byte array (169 bytes)
+        let su8 = &seed;
+        let seedu8 : &[u8] = &su8;
+        let extsk: ExtendedSpendingKey = ExtendedSpendingKey::master(&seedu8); 
+        let extsk_bytes = extsk.to_bytes().to_vec(); 
+        marshall_to_haskell_var(&extsk_bytes, out, out_len, RW);
+    }
+}
+
+#[no_mangle]
+pub extern "C" fn rust_wrapper_sapling_paymentaddress(
+    extspk: *const u8,
+    extspk_len: usize,
+    div_ix: u32,
+    out: *mut u8,
+    out_len: &mut usize
+    ){
+    let extspk: Vec<u8> = marshall_from_haskell_var(extspk, extspk_len, RW);
+    let expsk = ExpandedSpendingKey::from_spending_key(&extspk);
+    let fvk = SaplingFullViewingKey::from_expanded_spending_key(&expsk); 
+    let dk = DiversifierKey::master(&extspk);
+    let result = sapling_find_address(&fvk, &dk, DiversifierIndex::from(div_ix));
+    match result {
+        Some((_d, p_address)) => {
+            marshall_to_haskell_var(&p_address.to_bytes().to_vec(), out, out_len, RW);
+        },
+        None => {
+            marshall_to_haskell_var(&vec![0], out, out_len, RW);
+        }
+    }
+}
+
 #[no_mangle]
 pub extern "C" fn rust_wrapper_derive_orchard_spending_key(
     seed: *const u8,

src/C/Zcash.chs

@@ -134,6 +134,21 @@ import ZcashHaskell.Types
   -> `()'
 #}
 
+{# fun unsafe rust_wrapper_sapling_spendingkey as rustWrapperSaplingSpendingkey
+     { toBorshVar* `BS.ByteString'&
+     , getVarBuffer `Buffer (BS.ByteString)'&
+     }
+  -> `()'
+#}
+
+{# fun unsafe rust_wrapper_sapling_paymentaddress as rustWrapperSaplingPaymentAddress
+     { toBorshVar* `BS.ByteString'&
+     , `Word32'
+     , getVarBuffer `Buffer (BS.ByteString)'&
+     }
+  -> `()'
+#}
+
 {# fun unsafe rust_wrapper_derive_orchard_spending_key as rustWrapperGenOrchardSpendKey
      { toBorshVar* `BS.ByteString'&
      , `Word32'

src/ZcashHaskell/Sapling.hs

@@ -21,17 +21,28 @@ import C.Zcash
   ( rustWrapperIsShielded
   , rustWrapperSaplingCheck
   , rustWrapperSaplingNoteDecode
+  , rustWrapperSaplingPaymentAddress
+  , rustWrapperSaplingSpendingkey
   , rustWrapperSaplingVkDecode
   , rustWrapperTxParse
   )
 import Data.Aeson
 import qualified Data.ByteString as BS
 import Data.HexString (HexString(..), toBytes)
-import Foreign.Rust.Marshall.Variable (withPureBorshVarBuffer)
+import Data.Word
+import Foreign.Rust.Marshall.Variable
+  ( withPureBorshVarBuffer
+  , withPureBorshVarBuffer
+  )
 import ZcashHaskell.Types
-  ( DecodedNote(..)
+  ( AccountId
+  , CoinType
+  , DecodedNote(..)
   , RawData(..)
   , RawTxResponse(..)
+  , SaplingReceiver
+  , SaplingSpendingKey(..)
+  , Seed(..)
   , ShieldedOutput(..)
   , decodeHexText
   )
@@ -81,3 +92,25 @@ instance FromJSON RawTxResponse where
         Just o' -> do
           a <- o' .: "actions"
           pure $ RawTxResponse i h (getShieldedOutputs h) a ht c b
+
+--
+-- | Attempts to obtain a sapling SpendingKey using a HDSeed
+genSaplingSpendingKey :: Seed -> Maybe SaplingSpendingKey
+genSaplingSpendingKey seed = do
+  if BS.length res == 196
+    then Just res
+    else Nothing
+  where
+    res = withPureBorshVarBuffer (rustWrapperSaplingSpendingkey seed)
+
+--
+-- | Attempts to generate a sapling Payment Address using an ExtendedSpendingKey and a Diversifier Index 
+genSaplingPaymentAddress :: SaplingSpendingKey -> Int -> Maybe SaplingReceiver
+genSaplingPaymentAddress extspk i =
+  if BS.length res == 43
+    then Just res
+    else Nothing
+  where
+    res =
+      withPureBorshVarBuffer
+        (rustWrapperSaplingPaymentAddress extspk (fromIntegral i))

src/ZcashHaskell/Transparent.hs

@@ -29,6 +29,10 @@ import ZcashHaskell.Types
   , getTransparentPrefix
   )
 
+import Haskoin.Crypto.Keys.Extended
+import Data.Word
+import Crypto.Secp256k1
+
 encodeTransparent :: TransparentAddress -> T.Text
 encodeTransparent t =
   encodeTransparent' (getTransparentPrefix (ta_net t) (ta_type t)) $ ta_bytes t
@@ -41,3 +45,19 @@ encodeTransparent t =
         sha256 bs = BA.convert (hash bs :: Digest SHA256)
         digest = BS.pack [a, b] <> h
         checksum = sha256 $ sha256 digest
+
+-- | Attempts to generate an Extended Private Key from a known HDSeed.
+genTransparentPrvKey ::
+    BS.ByteString -> XPrvKey
+genTransparentPrvKey hdseed = do
+    makeXPrvKey hdseed
+
+-- | Attempts to obtain an Extended Public Key from a known Extended Private Key
+genTransparentPubKey ::
+    XPrvKey -> IO XPubKey
+genTransparentPubKey xpvk = do
+    ioCtx <- createContext
+    let xpubk = deriveXPubKey ioCtx xpvk
+    return xpubk
+
+

src/ZcashHaskell/Utils.hs

@@ -32,6 +32,13 @@ import Foreign.Rust.Marshall.Variable
 import Network.HTTP.Simple
 import ZcashHaskell.Types
 
+import Foreign.C.Types
+import Foreign.Marshal.Array (allocaArray, peekArray)
+import Foreign.Ptr (Ptr)
+
+import Data.Word
+
+-- | 
 -- | Decode the given bytestring using Bech32
 decodeBech32 :: BS.ByteString -> RawData
 decodeBech32 = withPureBorshVarBuffer . rustWrapperBech32Decode

test/Spec.hs

@@ -32,7 +32,7 @@ import qualified Data.Text as T
 import qualified Data.Text.Encoding as E
 import qualified Data.Text.Lazy.Encoding as LE
 import qualified Data.Text.Lazy.IO as LTIO
-import Data.Word
+
 import GHC.Float.RealFracMethods (properFractionDoubleInteger)
 import Test.Hspec
 import Test.Hspec.QuickCheck
@@ -41,15 +41,21 @@ import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed)
 import ZcashHaskell.Orchard
 import ZcashHaskell.Sapling
   ( decodeSaplingOutput
+  , genSaplingPaymentAddress
+  , genSaplingSpendingKey
   , getShieldedOutputs
   , isValidSaplingViewingKey
   , isValidShieldedAddress
   , matchSaplingAddress
   )
-import ZcashHaskell.Transparent (encodeTransparent)
+import ZcashHaskell.Transparent
+  --(encodeTransparent)
+
 import ZcashHaskell.Types
-  ( BlockResponse(..)
+  ( AccountId
+  , BlockResponse(..)
   , CoinType(..)
+  , CoinType
   , DecodedNote(..)
   , OrchardAction(..)
   , Phrase(..)
@@ -59,9 +65,17 @@ import ZcashHaskell.Types
   , UnifiedAddress(..)
   , UnifiedFullViewingKey(..)
   , decodeHexText
+  , getValue
   )
 import ZcashHaskell.Utils
 
+import Data.Word
+import Foreign.C.Types
+import Haskoin.Crypto.Keys.Extended
+
+m2bs :: Maybe BS.ByteString -> BS.ByteString
+m2bs x = fromMaybe "" x
+
 main :: IO ()
 main = do
   hspec $ do
@@ -467,6 +481,253 @@ main = do
                 Nothing -> "Bad UA"
                 Just u -> maybe "No transparent" encodeTransparent $ t_rec u
         msg `shouldBe` "t1LPWuQnjCRH7JAeEErSXKixcUteLJRJjKD"
+    describe "Transparent Private and Publicc Key Generation" $ do
+      it "Obtain a transparent extended private key from HDSeed" $ do
+        let hdseed =
+              [ 206
+              , 61
+              , 120
+              , 38
+              , 206
+              , 40
+              , 201
+              , 62
+              , 83
+              , 175
+              , 151
+              , 131
+              , 218
+              , 141
+              , 206
+              , 254
+              , 28
+              , 244
+              , 172
+              , 213
+              , 128
+              , 248
+              , 156
+              , 45
+              , 204
+              , 44
+              , 169
+              , 3
+              , 162
+              , 188
+              , 16
+              , 173
+              , 192
+              , 164
+              , 96
+              , 148
+              , 91
+              , 52
+              , 244
+              , 83
+              , 149
+              , 169
+              , 82
+              , 196
+              , 199
+              , 53
+              , 177
+              , 170
+              , 1
+              , 6
+              , 0
+              , 120
+              , 170
+              , 2
+              , 238
+              , 219
+              , 241
+              , 243
+              , 172
+              , 178
+              , 104
+              , 81
+              , 159
+              , 144
+              ] :: [Word8]
+        let xtpvk = genTransparentPrvKey (BS.pack hdseed)
+        let testpvk =
+              XPrvKey
+                0
+                "0000000000"
+                0
+                "fb5b9b89d3e9dfdebeaabd15de8fbc7e9a140b7f2de2b4034c2573425d39aceb"
+                "46aa0cd24a6e05709591426a4e682dd5406de4e75a39c0f410ee790403880943"
+        xtpvk `shouldBe` testpvk
+      it "Obtain a transparent extended public key from private key" $ do
+        let testpvk =
+              XPrvKey
+                0
+                "0000000000"
+                0
+                "fb5b9b89d3e9dfdebeaabd15de8fbc7e9a140b7f2de2b4034c2573425d39aceb"
+                "46aa0cd24a6e05709591426a4e682dd5406de4e75a39c0f410ee790403880943"
+        let testpbk =
+              XPubKey
+                0
+                "00000000"
+                0
+                "fb5b9b89d3e9dfdebeaabd15de8fbc7e9a140b7f2de2b4034c2573425d39aceb"
+                "279bda9c704f6da479cedb12c7cf773b3a348569dc1cfa6002526bad67674fd737b84a2bdb1199ecab1c9fed1b9a38aba5ba19259c1510d733a2376118515cd8"
+        let xtpubkIO = genTransparentPubKey testpvk
+        xtpubk <- xtpubkIO
+          ---print $ show xtpubk
+        xtpubk `shouldBe` testpbk
+    describe "Sapling SpendingKey test" $ do
+      let hdseed =
+            BS.pack $
+            [ 206
+            , 61
+            , 120
+            , 38
+            , 206
+            , 40
+            , 201
+            , 62
+            , 83
+            , 175
+            , 151
+            , 131
+            , 218
+            , 141
+            , 206
+            , 254
+            , 28
+            , 244
+            , 172
+            , 213
+            , 128
+            , 248
+            , 156
+            , 45
+            , 204
+            , 44
+            , 169
+            , 3
+            , 162
+            , 188
+            , 16
+            , 173
+            , 192
+            , 164
+            , 96
+            , 148
+            , 91
+            , 52
+            , 244
+            , 83
+            , 149
+            , 169
+            , 82
+            , 196
+            , 199
+            , 53
+            , 177
+            , 170
+            , 1
+            , 6
+            , 0
+            , 120
+            , 170
+            , 2
+            , 238
+            , 219
+            , 241
+            , 243
+            , 172
+            , 178
+            , 104
+            , 81
+            , 159
+            , 144
+            ]
+      --xit "Call function with parameters" $ do
+        --let msg = genSaplingSpendingKey (word8ArrayToByteString hdseed)
+        --let msgArr = BS.unpack msg
+        --if (length msgArr) == 169
+          --then True
+          --else False
+      it "Generate Sapling spending key" $ do
+        p <- generateWalletSeedPhrase
+        let s = getWalletSeed p
+        genSaplingSpendingKey <$> s `shouldNotBe` Nothing
+    describe "Sapling Payment Address generation test" $ do
+      it "Call genSaplingPaymentAddress" $ do
+        let hdseed1 =
+              [ 206
+              , 61
+              , 120
+              , 38
+              , 206
+              , 40
+              , 201
+              , 62
+              , 83
+              , 175
+              , 151
+              , 131
+              , 218
+              , 141
+              , 206
+              , 254
+              , 28
+              , 244
+              , 172
+              , 213
+              , 128
+              , 248
+              , 156
+              , 45
+              , 204
+              , 44
+              , 169
+              , 3
+              , 162
+              , 188
+              , 16
+              , 173
+              , 192
+              , 164
+              , 96
+              , 148
+              , 91
+              , 52
+              , 244
+              , 83
+              , 149
+              , 169
+              , 82
+              , 196
+              , 199
+              , 53
+              , 177
+              , 170
+              , 1
+              , 6
+              , 0
+              , 120
+              , 170
+              , 2
+              , 238
+              , 219
+              , 241
+              , 243
+              , 172
+              , 178
+              , 104
+              , 81
+              , 159
+              , 144
+              ] :: [Word8]
+        p <- generateWalletSeedPhrase
+        let s = getWalletSeed p
+        genSaplingPaymentAddress (fromMaybe "" s) 0 `shouldNotBe` Nothing
+      prop "Sapling receivers are valid" $
+        forAll genSapArgs $ \(i) -> prop_SaplingReceiver i
 
 -- | Properties
 prop_PhraseLength :: Int -> Property
@@ -497,6 +758,14 @@ prop_OrchardReceiver c i j =
     let sk = genOrchardSpendingKey (fromMaybe "" s) c i
     return $ genOrchardReceiver j (fromMaybe "" sk) =/= Nothing
 
+prop_SaplingReceiver :: Int -> Property
+prop_SaplingReceiver i =
+  ioProperty $ do
+    p <- generateWalletSeedPhrase
+    let s = getWalletSeed p
+    let sk = genSaplingSpendingKey (fromMaybe "" s)
+    return $ genSaplingPaymentAddress (fromMaybe "" sk) i =/= Nothing
+
 -- | Generators
 genOrcArgs :: Gen (CoinType, Int, Int)
 genOrcArgs = do
@@ -504,4 +773,7 @@ genOrcArgs = do
   j <- arbitrarySizedNatural
   c <- elements [MainNetCoin, TestNetCoin, RegTestNetCoin]
   return (c, i, j)
+
+genSapArgs :: Gen Int
+genSapArgs = choose (1, 50)
 -- | Arbitrary instances

zcash-haskell.cabal

@@ -5,7 +5,7 @@ cabal-version: 3.0
 -- see: https://github.com/sol/hpack
 
 name:           zcash-haskell
-version:        0.4.4.0
+version:        0.4.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
@@ -55,6 +55,8 @@ library
     , http-conduit
     , memory
     , text
+    , haskoin-core
+    , secp256k1-haskell
   build-tool-depends:
     c2hs:c2hs
   default-language: Haskell2010
@@ -76,5 +78,8 @@ test-suite zcash-haskell-test
     , quickcheck-transformer
     , text
     , zcash-haskell
+    , binary
+    , cryptonite
+    , secp256k1-haskell
   pkgconfig-depends: rustzcash_wrapper
   default-language: Haskell2010