Compare commits

...

7 commits

5 changed files with 84 additions and 54 deletions

View file

@ -26,6 +26,7 @@ use zip32;
use zcash_primitives::{ use zcash_primitives::{
zip32::{ zip32::{
Scope as SaplingScope, Scope as SaplingScope,
ChildIndex,
sapling_find_address, sapling_find_address,
sapling::DiversifierKey sapling::DiversifierKey
}, },
@ -629,21 +630,20 @@ pub extern "C" fn rust_wrapper_recover_seed(
pub extern "C" fn rust_wrapper_sapling_spendingkey( pub extern "C" fn rust_wrapper_sapling_spendingkey(
iseed: *const u8, iseed: *const u8,
iseed_len: usize, iseed_len: usize,
ix: u32,
out: *mut u8, out: *mut u8,
out_len: &mut usize out_len: &mut usize
){ ){
let seed: Vec<u8> = marshall_from_haskell_var(iseed, iseed_len, RW); 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 su8 = &seed;
let seedu8 : &[u8] = &su8; let seedu8 : &[u8] = &su8;
let extsk: ExtendedSpendingKey = ExtendedSpendingKey::master(&seedu8); let extsk: ExtendedSpendingKey = ExtendedSpendingKey::master(&seedu8);
if ix == 0 {
let extsk_bytes = extsk.to_bytes().to_vec(); let extsk_bytes = extsk.to_bytes().to_vec();
marshall_to_haskell_var(&extsk_bytes, out, out_len, RW); marshall_to_haskell_var(&extsk_bytes, out, out_len, RW);
} else {
let child_sk = extsk.derive_child(ChildIndex::from_index(ix));
marshall_to_haskell_var(&child_sk.to_bytes().to_vec(), out, out_len, RW);
} }
} }

View file

@ -136,6 +136,7 @@ import ZcashHaskell.Types
{# fun unsafe rust_wrapper_sapling_spendingkey as rustWrapperSaplingSpendingkey {# fun unsafe rust_wrapper_sapling_spendingkey as rustWrapperSaplingSpendingkey
{ toBorshVar* `BS.ByteString'& { toBorshVar* `BS.ByteString'&
, `Word32'
, getVarBuffer `Buffer (BS.ByteString)'& , getVarBuffer `Buffer (BS.ByteString)'&
} }
-> `()' -> `()'

View file

@ -96,13 +96,15 @@ instance FromJSON RawTxResponse where
pure $ RawTxResponse i h (getShieldedOutputs h) a ht c b pure $ RawTxResponse i h (getShieldedOutputs h) a ht c b
-- | Attempts to obtain a sapling SpendingKey using a HDSeed -- | Attempts to obtain a sapling SpendingKey using a HDSeed
genSaplingSpendingKey :: Seed -> Maybe SaplingSpendingKey genSaplingSpendingKey :: Seed -> Int -> Maybe SaplingSpendingKey
genSaplingSpendingKey seed = do genSaplingSpendingKey seed i = do
if BS.length res == 196 if BS.length res == 169
then Just res then Just res
else Nothing else Nothing
where where
res = withPureBorshVarBuffer (rustWrapperSaplingSpendingkey seed) res =
withPureBorshVarBuffer
(rustWrapperSaplingSpendingkey seed (fromIntegral i))
-- | Attempts to generate a sapling Payment Address using an ExtendedSpendingKey and a Diversifier Index -- | Attempts to generate a sapling Payment Address using an ExtendedSpendingKey and a Diversifier Index
genSaplingPaymentAddress :: SaplingSpendingKey -> Int -> Maybe SaplingReceiver genSaplingPaymentAddress :: SaplingSpendingKey -> Int -> Maybe SaplingReceiver
@ -116,6 +118,12 @@ genSaplingPaymentAddress extspk i =
(rustWrapperSaplingPaymentAddress extspk (fromIntegral i)) (rustWrapperSaplingPaymentAddress extspk (fromIntegral i))
-- | Generate an internal Sapling address -- | Generate an internal Sapling address
genSaplingInternalAddress :: SaplingSpendingKey -> BS.ByteString -- SaplingInternalReceiver genSaplingInternalAddress :: SaplingSpendingKey -> Maybe SaplingInternalReceiver
genSaplingInternalAddress sk = withPureBorshVarBuffer (rustWrapperSaplingChgPaymentAddress sk) genSaplingInternalAddress sk =
if BS.length res <> 0
then Just res
else Nothing
where
res =
withPureBorshVarBuffer (rustWrapperSaplingChgPaymentAddress sk)

View file

@ -20,6 +20,7 @@
{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE TypeSynonymInstances #-}
import C.Zcash (rustWrapperUADecode) import C.Zcash (rustWrapperUADecode)
import Control.Exception (throwIO)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Data.Aeson import Data.Aeson
import Data.Bool (Bool(True)) import Data.Bool (Bool(True))
@ -44,6 +45,7 @@ import ZcashHaskell.Sapling
, genSaplingPaymentAddress , genSaplingPaymentAddress
, genSaplingInternalAddress , genSaplingInternalAddress
, genSaplingSpendingKey , genSaplingSpendingKey
, genSaplingMasterSpendingKey
, getShieldedOutputs , getShieldedOutputs
, isValidSaplingViewingKey , isValidSaplingViewingKey
, isValidShieldedAddress , isValidShieldedAddress
@ -62,6 +64,7 @@ import ZcashHaskell.Types
, Phrase(..) , Phrase(..)
, RawData(..) , RawData(..)
, RawTxResponse(..) , RawTxResponse(..)
, Seed(..)
, ShieldedOutput(..) , ShieldedOutput(..)
, UnifiedAddress(..) , UnifiedAddress(..)
, UnifiedFullViewingKey(..) , UnifiedFullViewingKey(..)
@ -467,12 +470,20 @@ main = do
msg `shouldBe` msg `shouldBe`
"Hello World!\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL" "Hello World!\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL"
describe "Wallet seed phrase" $ do describe "Wallet seed phrase" $ do
prop "Generated phrases are valid" prop_PhraseLength prop "Generated phrases are valid" $ again prop_PhraseLength
prop "Derived seeds are valid" prop_SeedLength prop "Derived seeds are valid" $ again prop_SeedLength
prop "Orchard spending keys are valid" $ before getSeed $
forAll genOrcArgs $ \(c, i, _) -> prop_OrchardSpendingKey c i describe "Optimized spending key tests" $ do
prop "Orchard receivers are valid" $ it "Sapling spending keys are valid" $ \s ->
forAll genOrcArgs $ \(c, i, j) -> prop_OrchardReceiver c i j property $ prop_SaplingSpendingKey s
it "Sapling receivers are valid" $ \s ->
property $ prop_SaplingReceiver s
it "Sapling receivers are not the same" $ \s ->
property $ prop_SaplingRecRepeated s
it "Orchard spending keys are valid" $ \s ->
property $ prop_OrchardSpendingKey s
it "Orchard receivers are valid" $ \s ->
property $ prop_OrchardReceiver s
describe "Address tests" $ do describe "Address tests" $ do
it "Encode transparent" $ do it "Encode transparent" $ do
let ua = let ua =
@ -578,11 +589,11 @@ main = do
xtpubk <- xtpubkIO xtpubk <- xtpubkIO
---print $ show xtpubk ---print $ show xtpubk
xtpubk `shouldBe` testpbk xtpubk `shouldBe` testpbk
describe "Sapling SpendingKey test" $ do -- describe "Sapling SpendingKey test" $ do
it "Generate Sapling spending key" $ do -- it "Generate Sapling spending key" $ do
p <- generateWalletSeedPhrase -- p <- generateWalletSeedPhrase
let s = getWalletSeed p -- let s = getWalletSeed p
genSaplingSpendingKey <$> s `shouldNotBe` Nothing -- genSaplingSpendingKey <$> s `shouldNotBe` Nothing
describe "Sapling Payment Address generation test" $ do describe "Sapling Payment Address generation test" $ do
it "Call genSaplingPaymentAddress" $ do it "Call genSaplingPaymentAddress" $ do
p <- generateWalletSeedPhrase p <- generateWalletSeedPhrase
@ -761,7 +772,7 @@ main = do
, 216 , 216
, 48 , 48
, 201] :: [Word8] , 201] :: [Word8]
let cAdr = [31, 232, 31, 17, 195, -- 196 let cAdr = [31, 232, 31, 17, 196,
178, 208, 227, 206, 178, 208, 227, 206,
199, 105, 55, 147, 199, 105, 55, 147,
23, 151, 206, 117, 23, 151, 206, 117,
@ -774,44 +785,43 @@ main = do
22, 41] :: [Word8] 22, 41] :: [Word8]
let bscAdr = BS.pack cAdr let bscAdr = BS.pack cAdr
let ca = genSaplingInternalAddress (BS.pack sk) let ca = genSaplingInternalAddress (BS.pack sk)
ca `shouldBe` bscAdr (fromMaybe "" ca) `shouldBe` bscAdr
-- | Properties -- | Properties
prop_PhraseLength :: Int -> Property prop_PhraseLength :: Property
prop_PhraseLength i = prop_PhraseLength =
ioProperty $ do ioProperty $ do
p <- generateWalletSeedPhrase p <- generateWalletSeedPhrase
return $ BS.length p >= 95 return $ BS.length p >= 95
prop_SeedLength :: Int -> Property prop_SeedLength :: Property
prop_SeedLength i = prop_SeedLength =
ioProperty $ do ioProperty $ do
p <- generateWalletSeedPhrase p <- generateWalletSeedPhrase
let s = getWalletSeed p let s = getWalletSeed p
return $ maybe 0 BS.length s === 64 return $ maybe 0 BS.length s === 64
prop_OrchardSpendingKey :: CoinType -> Int -> Property prop_OrchardSpendingKey :: Seed -> CoinType -> NonNegative Int -> Property
prop_OrchardSpendingKey c i = prop_OrchardSpendingKey s c (NonNegative i) =
ioProperty $ do genOrchardSpendingKey s c i =/= Nothing
p <- generateWalletSeedPhrase
let s = getWalletSeed p
return $ genOrchardSpendingKey (fromMaybe "" s) c i =/= Nothing
prop_OrchardReceiver :: CoinType -> Int -> Int -> Property prop_OrchardReceiver ::
prop_OrchardReceiver c i j = Seed -> CoinType -> NonNegative Int -> NonNegative Int -> Property
ioProperty $ do prop_OrchardReceiver s c (NonNegative i) (NonNegative j) =
p <- generateWalletSeedPhrase genOrchardReceiver j (fromMaybe "" $ genOrchardSpendingKey s c i) =/= Nothing
let s = getWalletSeed p
let sk = genOrchardSpendingKey (fromMaybe "" s) c i
return $ genOrchardReceiver j (fromMaybe "" sk) =/= Nothing
prop_SaplingReceiver :: Int -> Property prop_SaplingSpendingKey :: Seed -> NonNegative Int -> Property
prop_SaplingReceiver i = prop_SaplingSpendingKey s (NonNegative i) =
ioProperty $ do genSaplingSpendingKey s i =/= Nothing
p <- generateWalletSeedPhrase
let s = getWalletSeed p prop_SaplingReceiver :: Seed -> NonNegative Int -> NonNegative Int -> Property
let sk = genSaplingSpendingKey (fromMaybe "" s) prop_SaplingReceiver s (NonNegative i) (NonNegative j) =
return $ genSaplingPaymentAddress (fromMaybe "" sk) i =/= Nothing genSaplingPaymentAddress (fromMaybe "" $ genSaplingSpendingKey s j) i =/=
Nothing
prop_SaplingRecRepeated :: Seed -> NonNegative Int -> Property
prop_SaplingRecRepeated s (NonNegative i) =
genSaplingPaymentAddress (fromMaybe "" $ genSaplingSpendingKey s 1) i =/=
genSaplingPaymentAddress (fromMaybe "" $ genSaplingSpendingKey s 1) (i + 1)
-- | Generators -- | Generators
genOrcArgs :: Gen (CoinType, Int, Int) genOrcArgs :: Gen (CoinType, Int, Int)
@ -823,4 +833,15 @@ genOrcArgs = do
genSapArgs :: Gen Int genSapArgs :: Gen Int
genSapArgs = choose (1, 50) genSapArgs = choose (1, 50)
getSeed :: IO Seed
getSeed = do
p <- generateWalletSeedPhrase
let s = getWalletSeed p
case s of
Nothing -> throwIO $ userError "Couldn't generate seed"
Just s' -> return s'
-- | Arbitrary instances -- | Arbitrary instances
instance Arbitrary CoinType where
arbitrary = elements [MainNetCoin, TestNetCoin, RegTestNetCoin]

View file

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