Vergara_Tech/zcash-haskell
2
0
Fork 0
Code Issues Pull requests Projects Releases 5 Packages Wiki Activity

Merge with dev040

Browse source
This commit is contained in:
Rene V. Vergara A. 2024-03-13 15:37:23 -04:00
commit 5815c5c326
10 changed files with 184 additions and 90 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
cabal.project
View file

@ -10,4 +10,4 @@ source-repository-package
source-repository-package
type: git
location: https://git.vergara.tech/Vergara_Tech/haskell-hexstring.git
tag: fd1ddce73c0ad18a2a4509a299c6e93f8c6c383d
tag: 39d8da7b11a80269454c2f134a5c834e0f3cb9a7

2
cabal.project.freeze
View file

@ -99,7 +99,7 @@ constraints: any.Cabal ==3.8.1.0,
hashable +integer-gmp -random-initial-seed,
any.haskell-lexer ==1.1.1,
any.haskoin-core ==1.0.4,
any.hexstring ==0.12.0,
any.hexstring ==0.12.1.0,
any.hourglass ==0.2.12,
any.hsc2hs ==0.68.10,
hsc2hs -in-ghc-tree,

57
librustzcash-wrapper/src/lib.rs
View file

@ -59,12 +59,13 @@ use zcash_address::{
};
use zcash_client_backend::keys::sapling::{
spending_key,
ExtendedFullViewingKey,
ExtendedSpendingKey,
DiversifiableFullViewingKey
};
use zcash_primitives::zip32::{ AccountId, DiversifierIndex };
use zcash_primitives::zip32::DiversifierIndex;
use orchard::{
Action,
@ -628,23 +629,16 @@ pub extern "C" fn rust_wrapper_recover_seed(
#[no_mangle]
pub extern "C" fn rust_wrapper_sapling_spendingkey(
iseed: *const u8,
iseed_len: usize,
ix: u32,
seed: *const u8,
seed_len: usize,
coin_type: u32,
acc_id: u32,
out: *mut u8,
out_len: &mut usize
){
let seed: Vec<u8> = marshall_from_haskell_var(iseed, iseed_len, RW);
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);
}
let s: Vec<u8> = marshall_from_haskell_var(seed, seed_len, RW);
let sk = spending_key(&s, coin_type, zcash_primitives::zip32::AccountId::try_from(acc_id).unwrap());
marshall_to_haskell_var(&sk.to_bytes().to_vec(), out, out_len, RW);
}
#[no_mangle]
@ -656,16 +650,29 @@ pub extern "C" fn rust_wrapper_sapling_paymentaddress(
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);
if div_ix == 0 {
let sp_key = ExtendedSpendingKey::from_bytes(&extspk);
match sp_key {
Ok(sp_key_x) => {
let (def_div, def_address) = sp_key_x.default_address();
marshall_to_haskell_var(&def_address.to_bytes().to_vec(), out, out_len, RW);
},
Err(_e) => {
marshall_to_haskell_var(&vec![0], out, out_len, RW);
}
}
} else {
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);
}
}
}
}

1
src/C/Zcash.chs
View file

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

9
src/ZcashHaskell/Orchard.hs
View file

@ -27,6 +27,7 @@ import C.Zcash
)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as C
import Data.HexString (fromRawBytes, toBytes)
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import Data.Word
@ -83,9 +84,9 @@ isValidUnifiedAddress str =
then Just (raw_s x)
else Nothing)
(if not (BS.null (raw_t x))
then Just $ TransparentAddress P2PKH whichNet (raw_t x)
then Just $ TransparentAddress P2PKH (fromRawBytes $ raw_t x)
else if not (BS.null (raw_to x))
then Just $ TransparentAddress P2SH whichNet (raw_to x)
then Just $ TransparentAddress P2SH (fromRawBytes $ raw_to x)
else Nothing)
-- | Encode a 'UnifiedAddress' per [ZIP-316](https://zips.z.cash/zip-0316)
@ -102,8 +103,8 @@ encodeUnifiedAddress ua = encodeBech32m (E.encodeUtf8 hr) b
Nothing -> BS.empty
Just t ->
case ta_type t of
P2SH -> packReceiver 0x01 $ Just $ ta_bytes t
P2PKH -> packReceiver 0x00 $ Just $ ta_bytes t
P2SH -> packReceiver 0x01 $ Just $ toBytes $ ta_bytes t
P2PKH -> packReceiver 0x00 $ Just $ toBytes $ ta_bytes t
sReceiver = packReceiver 0x02 $ s_rec ua
oReceiver = packReceiver 0x03 $ o_rec ua
padding = E.encodeUtf8 $ T.justifyLeft 16 '\NUL' hr

16
src/ZcashHaskell/Sapling.hs
View file

@ -47,6 +47,7 @@ import ZcashHaskell.Types
, Seed(..)
, ShieldedOutput(..)
, decodeHexText
, getValue
)
import ZcashHaskell.Utils (decodeBech32)
@ -96,26 +97,29 @@ 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 -> Int -> Maybe SaplingSpendingKey
genSaplingSpendingKey seed i = do
genSaplingSpendingKey :: Seed -> CoinType -> Int -> Maybe SaplingSpendingKey
genSaplingSpendingKey seed c i = do
if BS.length res == 169
then Just res
else Nothing
where
res =
withPureBorshVarBuffer
(rustWrapperSaplingSpendingkey seed (fromIntegral i))
(rustWrapperSaplingSpendingkey
seed
(fromIntegral $ getValue c)
(fromIntegral i))
-- | Attempts to generate a sapling Payment Address using an ExtendedSpendingKey and a Diversifier Index
genSaplingPaymentAddress :: SaplingSpendingKey -> Int -> Maybe SaplingReceiver
genSaplingPaymentAddress extspk i =
genSaplingPaymentAddress :: Int -> SaplingSpendingKey -> Maybe SaplingReceiver
genSaplingPaymentAddress i extspk =
if BS.length res == 43
then Just res
else Nothing
where
res =
withPureBorshVarBuffer
(rustWrapperSaplingPaymentAddress extspk (fromIntegral i))
(rustWrapperSaplingPaymentAddress extspk (fromIntegral (i * 111)))
-- | Generate an internal Sapling address
genSaplingInternalAddress :: SaplingSpendingKey -> Maybe SaplingInternalReceiver

49
src/ZcashHaskell/Transparent.hs
View file

@ -15,27 +15,33 @@
--
module ZcashHaskell.Transparent where
import Control.Exception (throwIO)
import Crypto.Hash
import qualified Data.ByteArray as BA
import qualified Data.ByteString as BS
import Data.ByteString.Base58 (bitcoinAlphabet, encodeBase58)
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import Data.Word
import ZcashHaskell.Types
( TransparentAddress(..)
( AccountId
, Seed
, TransparentAddress(..)
, TransparentType(..)
, ZcashNet(..)
, getTransparentPrefix
)
import Haskoin.Crypto.Keys.Extended
import Data.Word
import Crypto.Secp256k1
import Data.HexString
import Data.Word
import Haskoin.Address (Address(..))
import qualified Haskoin.Crypto.Hash as H
import Haskoin.Crypto.Keys.Extended
encodeTransparent :: TransparentAddress -> T.Text
encodeTransparent t =
encodeTransparent' (getTransparentPrefix (ta_net t) (ta_type t)) $ ta_bytes t
encodeTransparent :: ZcashNet -> TransparentAddress -> T.Text
encodeTransparent zNet t =
encodeTransparent' (getTransparentPrefix zNet (ta_type t)) $
toBytes $ ta_bytes t
where
encodeTransparent' :: (Word8, Word8) -> BS.ByteString -> T.Text
encodeTransparent' (a, b) h =
@ -47,17 +53,20 @@ encodeTransparent t =
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
genTransparentPrvKey :: Seed -> AccountId -> IO XPrvKey
genTransparentPrvKey hdseed i = do
let prvKey = makeXPrvKey hdseed
ioCtx <- createContext
return $ hardSubKey ioCtx prvKey (fromIntegral i)
-- | Generate a transparent receiver
genTransparentReceiver :: Int -> XPrvKey -> IO TransparentAddress
genTransparentReceiver i xprvk = do
ioCtx <- createContext
let rootPubKey = deriveXPubKey ioCtx xprvk
let childPubKey = pubSubKey ioCtx rootPubKey (fromIntegral i)
let x = xPubAddr ioCtx childPubKey
case x of
PubKeyAddress k -> return $ TransparentAddress P2PKH $ fromBinary k
ScriptAddress j -> return $ TransparentAddress P2SH $ fromBinary j
_anyOtherKind -> throwIO $ userError "Unsupported transparent address type"

34
src/ZcashHaskell/Types.hs
View file

@ -36,6 +36,7 @@ import qualified Data.Text.Encoding as E
import Data.Word
import qualified GHC.Generics as GHC
import qualified Generics.SOP as SOP
import Haskoin.Address (Address)
-- * General
--
@ -45,21 +46,6 @@ type Seed = C.ByteString
-- | A mnemonic phrase used to derive seeds
type Phrase = BS.ByteString
-- | A spending key for Sapling
type SaplingSpendingKey = BS.ByteString
-- | A spending key for Orchard
type OrchardSpendingKey = BS.ByteString
-- | A Sapling receiver
type SaplingReceiver = BS.ByteString
-- | A Sapling internal receiver
type SaplingInternalReceiver = BS.ByteString
-- | An Orchard receiver
type OrchardReceiver = BS.ByteString
-- | Type to represent data after Bech32 decoding
data RawData = RawData
{ hrp :: !BS.ByteString -- ^ Human-readable part of the Bech32 encoding
@ -250,11 +236,19 @@ data TransparentType
-- | Type to represent a transparent Zcash addresses
data TransparentAddress = TransparentAddress
{ ta_type :: !TransparentType
, ta_net :: !ZcashNet
, ta_bytes :: !BS.ByteString
, ta_bytes :: !HexString
} deriving (Eq, Prelude.Show, Read)
-- * Sapling
-- | A spending key for Sapling
type SaplingSpendingKey = BS.ByteString
-- | A Sapling receiver
type SaplingReceiver = BS.ByteString
-- | A Sapling internal receiver
type SaplingInternalReceiver = BS.ByteString
-- | Type to represent a Sapling Shielded Output as provided by the @getrawtransaction@ RPC method of @zcashd@.
data ShieldedOutput = ShieldedOutput
{ s_cv :: !HexString -- ^ Value commitment to the input note
@ -280,6 +274,12 @@ instance FromJSON ShieldedOutput where
pure $ ShieldedOutput cv cmu ephKey encText outText p
-- * Orchard
-- | A spending key for Orchard
type OrchardSpendingKey = BS.ByteString
-- | An Orchard receiver
type OrchardReceiver = BS.ByteString
-- | Type to represent a Unified Address
data UnifiedAddress = UnifiedAddress
{ ua_net :: !ZcashNet

100
test/Spec.hs
View file

@ -52,8 +52,6 @@ import ZcashHaskell.Sapling
, matchSaplingAddress
)
import ZcashHaskell.Transparent
--(encodeTransparent)
import ZcashHaskell.Types
( AccountId
, BlockResponse(..)
@ -66,8 +64,11 @@ import ZcashHaskell.Types
, RawTxResponse(..)
, Seed(..)
, ShieldedOutput(..)
, TransparentAddress(..)
, TransparentType(..)
, UnifiedAddress(..)
, UnifiedFullViewingKey(..)
, ZcashNet(..)
, decodeHexText
, getValue
)
@ -474,16 +475,22 @@ main = do
prop "Derived seeds are valid" $ again prop_SeedLength
before getSeed $
describe "Optimized spending key tests" $ do
it "Transparent spending keys are valid" $ \s ->
property $ prop_TransparentSpendingKey s
it "Transparent receivers are valid" $ \s ->
property $ prop_TransparentReceiver s
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 ->
it "Sapling receivers are distinct" $ \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
it "Orchard receivers are distinct" $ \s ->
property $ prop_OrchardRecRepeated s
describe "Address tests" $ do
it "Encode transparent" $ do
let ua =
@ -491,8 +498,11 @@ main = do
let msg =
case isValidUnifiedAddress ua of
Nothing -> "Bad UA"
Just u -> maybe "No transparent" encodeTransparent $ t_rec u
Just u ->
maybe "No transparent" (encodeTransparent (ua_net u)) $
t_rec u
msg `shouldBe` "t1LPWuQnjCRH7JAeEErSXKixcUteLJRJjKD"
<<<<<<< HEAD
describe "Transparent Private and Public Key Generation" $ do
it "Obtain a transparent extended private key from HDSeed" $ do
let hdseed =
@ -786,6 +796,47 @@ main = do
let bscAdr = BS.pack cAdr
let ca = genSaplingInternalAddress (BS.pack sk)
(fromMaybe "" ca) `shouldBe` bscAdr
=======
it "Recover UA from YWallet" $
ioProperty $ do
let p =
"security expect junk hour people bind law hub between topic wink cliff spirit scissors auction idle figure option wide useful swift prison cushion round"
let targetUA =
isValidUnifiedAddress
"u1qsylqauvnhw8tsfe3cldcsj3mjrfqzgaf3mt8yzlkjuvsf5wzj223yvrt8q66qukfqcc80x3z0mk6ym6pm2f0hukzkp6t4wj78h85t6kfr2u9mqsfhdd73g3sc7ezy2ut3rtq5jmejatwv4xqqd6l8tt9fycer8kdw0gz6e607nkssqsc7kd7nk2yfz2hpvpqhdg39wxalpjzhe34j7"
let s = getWalletSeed p
case s of
Nothing -> return $ expectationFailure "Failed to generate seed"
Just s' -> do
let oK = genOrchardSpendingKey s' MainNetCoin 0
let sK = genSaplingSpendingKey s' MainNetCoin 0
let tK = genTransparentPrvKey s' 0
let oR = genOrchardReceiver 0 =<< oK
let sR = genSaplingPaymentAddress 0 =<< sK
tR <- genTransparentReceiver 0 =<< tK
let newUA = UnifiedAddress MainNet oR sR $ Just tR
return $ Just newUA `shouldBe` targetUA
it "Recover UA from Zingo" $
ioProperty $ do
let p =
"cloth swing left trap random tornado have great onion element until make shy dad success art tuition canvas thunder apple decade elegant struggle invest"
let targetUA =
isValidUnifiedAddress
"u1trd8cvc6265ywwj4mmvuznsye5ghe2dhhn3zy8kcuyg4vx3svskw9r2dedp5hu6m740vylkqc34t4w9eqkl9fyu5uyzn3af72jg235440ke6tu5cf994eq85n97x69x9824hqejmwz3d8qqthtesrd6gerjupdymldhl9xccejjwfj0dhh9mt4rw4kytp325twlutsxd20rfqhzxu3m"
let s = getWalletSeed p
case s of
Nothing -> return $ expectationFailure "Failed to generate seed"
Just s' -> do
let oK = genOrchardSpendingKey s' MainNetCoin 0
let sK = genSaplingSpendingKey s' MainNetCoin 0
let tK = genTransparentPrvKey s' 0
let oR = genOrchardReceiver 0 =<< oK
let sR = genSaplingPaymentAddress 0 =<< sK
tR <- genTransparentReceiver 0 =<< tK
let newUA = UnifiedAddress MainNet oR sR $ Just tR
return $ Just newUA `shouldBe` targetUA
>>>>>>> origin/dev040
-- | Properties
prop_PhraseLength :: Property
prop_PhraseLength =
@ -809,19 +860,40 @@ prop_OrchardReceiver ::
prop_OrchardReceiver s c (NonNegative i) (NonNegative j) =
genOrchardReceiver j (fromMaybe "" $ genOrchardSpendingKey s c i) =/= Nothing
prop_SaplingSpendingKey :: Seed -> NonNegative Int -> Property
prop_SaplingSpendingKey s (NonNegative i) =
genSaplingSpendingKey s i =/= Nothing
prop_SaplingSpendingKey :: Seed -> CoinType -> NonNegative Int -> Property
prop_SaplingSpendingKey s c (NonNegative i) =
genSaplingSpendingKey s c i =/= Nothing
prop_SaplingReceiver :: Seed -> NonNegative Int -> NonNegative Int -> Property
prop_SaplingReceiver s (NonNegative i) (NonNegative j) =
genSaplingPaymentAddress (fromMaybe "" $ genSaplingSpendingKey s j) i =/=
prop_SaplingReceiver ::
Seed -> CoinType -> NonNegative Int -> NonNegative Int -> Property
prop_SaplingReceiver s c (NonNegative i) (NonNegative j) =
genSaplingPaymentAddress i (fromMaybe "" $ genSaplingSpendingKey s c j) =/=
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)
prop_SaplingRecRepeated :: Seed -> CoinType -> NonNegative Int -> Property
prop_SaplingRecRepeated s c (NonNegative i) =
genSaplingPaymentAddress i (fromMaybe "" $ genSaplingSpendingKey s c 1) =/=
genSaplingPaymentAddress (i + 1) (fromMaybe "" $ genSaplingSpendingKey s c 1)
prop_OrchardRecRepeated ::
Seed -> CoinType -> NonNegative Int -> NonNegative Int -> Property
prop_OrchardRecRepeated s c (NonNegative i) (NonNegative j) =
genOrchardReceiver j (fromMaybe "" $ genOrchardSpendingKey s c i) =/=
genOrchardReceiver (j + 1) (fromMaybe "" $ genOrchardSpendingKey s c i)
prop_TransparentSpendingKey :: Seed -> NonNegative Int -> Property
prop_TransparentSpendingKey s (NonNegative i) =
ioProperty $ do
k <- genTransparentPrvKey s i
return $ xPrvChild k == fromIntegral i
prop_TransparentReceiver ::
Seed -> NonNegative Int -> NonNegative Int -> Property
prop_TransparentReceiver s (NonNegative i) (NonNegative j) =
ioProperty $ do
k <- genTransparentPrvKey s i
r <- genTransparentReceiver j k
return $ ta_type r == P2PKH
-- | Generators
genOrcArgs :: Gen (CoinType, Int, Int)

4
zcash-haskell.cabal
View file

@ -51,7 +51,7 @@ library
, cryptonite
, foreign-rust
, generics-sop
, hexstring >=0.12
, hexstring >=0.12.1
, http-conduit
, memory
, text
@ -72,7 +72,7 @@ test-suite zcash-haskell-test
, base >=4.7 && <5
, bytestring
, haskoin-core
, hexstring
, hexstring >= 0.12.1
, hspec
, QuickCheck
, quickcheck-transformer