After merging with dev040
This commit is contained in:
commit
1d59e8f5eb
|
|
@ -26,6 +26,7 @@ use zip32;
|
|||
use zcash_primitives::{
|
||||
zip32::{
|
||||
Scope as SaplingScope,
|
||||
ChildIndex,
|
||||
sapling_find_address,
|
||||
sapling::DiversifierKey
|
||||
},
|
||||
|
|
@ -629,21 +630,20 @@ pub extern "C" fn rust_wrapper_recover_seed(
|
|||
pub extern "C" fn rust_wrapper_sapling_spendingkey(
|
||||
iseed: *const u8,
|
||||
iseed_len: usize,
|
||||
ix: u32,
|
||||
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 su8 = &seed;
|
||||
let seedu8 : &[u8] = &su8;
|
||||
let extsk: ExtendedSpendingKey = ExtendedSpendingKey::master(&seedu8);
|
||||
if ix == 0 {
|
||||
let extsk_bytes = extsk.to_bytes().to_vec();
|
||||
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);
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -136,6 +136,7 @@ import ZcashHaskell.Types
|
|||
|
||||
{# fun unsafe rust_wrapper_sapling_spendingkey as rustWrapperSaplingSpendingkey
|
||||
{ toBorshVar* `BS.ByteString'&
|
||||
, `Word32'
|
||||
, getVarBuffer `Buffer (BS.ByteString)'&
|
||||
}
|
||||
-> `()'
|
||||
|
|
|
|||
|
|
@ -96,13 +96,15 @@ instance FromJSON RawTxResponse where
|
|||
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
|
||||
genSaplingSpendingKey :: Seed -> Int -> Maybe SaplingSpendingKey
|
||||
genSaplingSpendingKey seed i = do
|
||||
if BS.length res == 169
|
||||
then Just res
|
||||
else Nothing
|
||||
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
|
||||
genSaplingPaymentAddress :: SaplingSpendingKey -> Int -> Maybe SaplingReceiver
|
||||
|
|
@ -116,6 +118,12 @@ genSaplingPaymentAddress extspk i =
|
|||
(rustWrapperSaplingPaymentAddress extspk (fromIntegral i))
|
||||
|
||||
-- | Generate an internal Sapling address
|
||||
genSaplingInternalAddress :: SaplingSpendingKey -> BS.ByteString -- SaplingInternalReceiver
|
||||
genSaplingInternalAddress sk = withPureBorshVarBuffer (rustWrapperSaplingChgPaymentAddress sk)
|
||||
genSaplingInternalAddress :: SaplingSpendingKey -> Maybe SaplingInternalReceiver
|
||||
genSaplingInternalAddress sk =
|
||||
if BS.length res <> 0
|
||||
then Just res
|
||||
else Nothing
|
||||
where
|
||||
res =
|
||||
withPureBorshVarBuffer (rustWrapperSaplingChgPaymentAddress sk)
|
||||
|
||||
97
test/Spec.hs
97
test/Spec.hs
|
|
@ -20,6 +20,7 @@
|
|||
{-# LANGUAGE TypeSynonymInstances #-}
|
||||
|
||||
import C.Zcash (rustWrapperUADecode)
|
||||
import Control.Exception (throwIO)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Data.Aeson
|
||||
import Data.Bool (Bool(True))
|
||||
|
|
@ -44,6 +45,7 @@ import ZcashHaskell.Sapling
|
|||
, genSaplingPaymentAddress
|
||||
, genSaplingInternalAddress
|
||||
, genSaplingSpendingKey
|
||||
, genSaplingMasterSpendingKey
|
||||
, getShieldedOutputs
|
||||
, isValidSaplingViewingKey
|
||||
, isValidShieldedAddress
|
||||
|
|
@ -62,6 +64,7 @@ import ZcashHaskell.Types
|
|||
, Phrase(..)
|
||||
, RawData(..)
|
||||
, RawTxResponse(..)
|
||||
, Seed(..)
|
||||
, ShieldedOutput(..)
|
||||
, UnifiedAddress(..)
|
||||
, UnifiedFullViewingKey(..)
|
||||
|
|
@ -467,12 +470,20 @@ main = do
|
|||
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"
|
||||
describe "Wallet seed phrase" $ do
|
||||
prop "Generated phrases are valid" prop_PhraseLength
|
||||
prop "Derived seeds are valid" prop_SeedLength
|
||||
prop "Orchard spending keys are valid" $
|
||||
forAll genOrcArgs $ \(c, i, _) -> prop_OrchardSpendingKey c i
|
||||
prop "Orchard receivers are valid" $
|
||||
forAll genOrcArgs $ \(c, i, j) -> prop_OrchardReceiver c i j
|
||||
prop "Generated phrases are valid" $ again prop_PhraseLength
|
||||
prop "Derived seeds are valid" $ again prop_SeedLength
|
||||
before getSeed $
|
||||
describe "Optimized spending key tests" $ do
|
||||
it "Sapling spending keys are valid" $ \s ->
|
||||
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
|
||||
it "Encode transparent" $ do
|
||||
let ua =
|
||||
|
|
@ -578,11 +589,11 @@ main = do
|
|||
xtpubk <- xtpubkIO
|
||||
---print $ show xtpubk
|
||||
xtpubk `shouldBe` testpbk
|
||||
describe "Sapling SpendingKey test" $ do
|
||||
it "Generate Sapling spending key" $ do
|
||||
p <- generateWalletSeedPhrase
|
||||
let s = getWalletSeed p
|
||||
genSaplingSpendingKey <$> s `shouldNotBe` Nothing
|
||||
-- describe "Sapling SpendingKey test" $ do
|
||||
-- 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
|
||||
p <- generateWalletSeedPhrase
|
||||
|
|
@ -761,7 +772,7 @@ main = do
|
|||
, 216
|
||||
, 48
|
||||
, 201] :: [Word8]
|
||||
let cAdr = [31, 232, 31, 17, 195, -- 196
|
||||
let cAdr = [31, 232, 31, 17, 196,
|
||||
178, 208, 227, 206,
|
||||
199, 105, 55, 147,
|
||||
23, 151, 206, 117,
|
||||
|
|
@ -774,44 +785,43 @@ main = do
|
|||
22, 41] :: [Word8]
|
||||
let bscAdr = BS.pack cAdr
|
||||
let ca = genSaplingInternalAddress (BS.pack sk)
|
||||
ca `shouldBe` bscAdr
|
||||
|
||||
(fromMaybe "" ca) `shouldBe` bscAdr
|
||||
-- | Properties
|
||||
prop_PhraseLength :: Int -> Property
|
||||
prop_PhraseLength i =
|
||||
prop_PhraseLength :: Property
|
||||
prop_PhraseLength =
|
||||
ioProperty $ do
|
||||
p <- generateWalletSeedPhrase
|
||||
return $ BS.length p >= 95
|
||||
|
||||
prop_SeedLength :: Int -> Property
|
||||
prop_SeedLength i =
|
||||
prop_SeedLength :: Property
|
||||
prop_SeedLength =
|
||||
ioProperty $ do
|
||||
p <- generateWalletSeedPhrase
|
||||
let s = getWalletSeed p
|
||||
return $ maybe 0 BS.length s === 64
|
||||
|
||||
prop_OrchardSpendingKey :: CoinType -> Int -> Property
|
||||
prop_OrchardSpendingKey c i =
|
||||
ioProperty $ do
|
||||
p <- generateWalletSeedPhrase
|
||||
let s = getWalletSeed p
|
||||
return $ genOrchardSpendingKey (fromMaybe "" s) c i =/= Nothing
|
||||
prop_OrchardSpendingKey :: Seed -> CoinType -> NonNegative Int -> Property
|
||||
prop_OrchardSpendingKey s c (NonNegative i) =
|
||||
genOrchardSpendingKey s c i =/= Nothing
|
||||
|
||||
prop_OrchardReceiver :: CoinType -> Int -> Int -> Property
|
||||
prop_OrchardReceiver c i j =
|
||||
ioProperty $ do
|
||||
p <- generateWalletSeedPhrase
|
||||
let s = getWalletSeed p
|
||||
let sk = genOrchardSpendingKey (fromMaybe "" s) c i
|
||||
return $ genOrchardReceiver j (fromMaybe "" sk) =/= Nothing
|
||||
prop_OrchardReceiver ::
|
||||
Seed -> CoinType -> NonNegative Int -> NonNegative Int -> Property
|
||||
prop_OrchardReceiver s c (NonNegative i) (NonNegative j) =
|
||||
genOrchardReceiver j (fromMaybe "" $ genOrchardSpendingKey s c i) =/= 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
|
||||
prop_SaplingSpendingKey :: Seed -> NonNegative Int -> Property
|
||||
prop_SaplingSpendingKey s (NonNegative i) =
|
||||
genSaplingSpendingKey s i =/= Nothing
|
||||
|
||||
prop_SaplingReceiver :: Seed -> NonNegative Int -> NonNegative Int -> Property
|
||||
prop_SaplingReceiver s (NonNegative i) (NonNegative j) =
|
||||
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
|
||||
genOrcArgs :: Gen (CoinType, Int, Int)
|
||||
|
|
@ -823,4 +833,15 @@ genOrcArgs = do
|
|||
|
||||
genSapArgs :: Gen Int
|
||||
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
|
||||
instance Arbitrary CoinType where
|
||||
arbitrary = elements [MainNetCoin, TestNetCoin, RegTestNetCoin]
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@ cabal-version: 3.0
|
|||
-- see: https://github.com/sol/hpack
|
||||
|
||||
name: zcash-haskell
|
||||
version: 0.4.4.1
|
||||
version: 0.4.4.2
|
||||
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
|
||||
|
|
|
|||
Loading…
Reference in New Issue