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

Merge pull request 'Unified Address Generation tests' (#31) from rav001 into dev040 

Reviewed-on: #31
This commit is contained in:
pitmutt 2024-03-12 21:06:06 +00:00 committed by Vergara Technologies LLC
parent 8d437105c9 4f20160c36
commit e69a26e984
Signed by: Vergara Technologies LLC
GPG Key ID: 99DB473BB4715618
9 changed files with 227 additions and 155 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,

35
librustzcash-wrapper/src/lib.rs
View File

@ -641,7 +641,7 @@ pub extern "C" fn rust_wrapper_sapling_spendingkey(
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));
let child_sk = extsk.derive_child(ChildIndex::from_index(ix + (1 << 31)));
marshall_to_haskell_var(&child_sk.to_bytes().to_vec(), out, out_len, RW);
}
}
@ -655,16 +655,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);
}
}
}
}

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

6
src/ZcashHaskell/Sapling.hs
View File

@ -106,15 +106,15 @@ genSaplingSpendingKey seed i = do
(rustWrapperSaplingSpendingkey seed (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

39
src/ZcashHaskell/Transparent.hs
View File

@ -15,13 +15,13 @@
--
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(..)
, TransparentType(..)
@ -29,13 +29,17 @@ import ZcashHaskell.Types
, 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 +51,22 @@ encodeTransparent t =
checksum = sha256 $ sha256 digest
-- | Attempts to generate an Extended Private Key from a known HDSeed.
genTransparentPrvKey ::
BS.ByteString -> XPrvKey
genTransparentPrvKey :: BS.ByteString -> XPrvKey
genTransparentPrvKey hdseed = do
makeXPrvKey hdseed
makeXPrvKey hdseed
-- | Attempts to obtain an Extended Public Key from a known Extended Private Key
genTransparentPubKey ::
XPrvKey -> IO XPubKey
genTransparentPubKey :: XPrvKey -> IO XPubKey
genTransparentPubKey xpvk = do
ioCtx <- createContext
let xpubk = deriveXPubKey ioCtx xpvk
return xpubk
ioCtx <- createContext
let xpubk = deriveXPubKey ioCtx xpvk
return xpubk
genTransparentReceiver :: XPubKey -> IO TransparentAddress
genTransparentReceiver xpubk = do
ioCtx <- createContext
let x = xPubAddr ioCtx xpubk
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

251
test/Spec.hs
View File

@ -66,6 +66,7 @@ import ZcashHaskell.Types
, ShieldedOutput(..)
, UnifiedAddress(..)
, UnifiedFullViewingKey(..)
, ZcashNet(..)
, decodeHexText
, getValue
)
@ -470,18 +471,116 @@ main = do
describe "Wallet seed phrase" $ do
prop "Generated phrases are valid" $ again prop_PhraseLength
prop "Derived seeds are valid" $ again prop_SeedLength
describe "Transparent Private and Public 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
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 ->
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 =
@ -489,104 +588,48 @@ 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"
describe "Transparent Private and Public 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
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' 0
let tK = genTransparentPrvKey s'
let oR = genOrchardReceiver 0 =<< oK
let sR = genSaplingPaymentAddress 0 =<< sK
tR <- genTransparentReceiver =<< genTransparentPubKey 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' 0
let tK = genTransparentPrvKey s'
let oR = genOrchardReceiver 0 =<< oK
let sR = genSaplingPaymentAddress 0 =<< sK
tR <- genTransparentReceiver =<< genTransparentPubKey tK
let newUA = UnifiedAddress MainNet oR sR $ Just tR
return $ Just newUA `shouldBe` targetUA
-- | Properties
prop_PhraseLength :: Property
@ -617,13 +660,19 @@ prop_SaplingSpendingKey s (NonNegative i) =
prop_SaplingReceiver :: Seed -> NonNegative Int -> NonNegative Int -> Property
prop_SaplingReceiver s (NonNegative i) (NonNegative j) =
genSaplingPaymentAddress (fromMaybe "" $ genSaplingSpendingKey s j) i =/=
genSaplingPaymentAddress i (fromMaybe "" $ genSaplingSpendingKey s 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)
genSaplingPaymentAddress i (fromMaybe "" $ genSaplingSpendingKey s 1) =/=
genSaplingPaymentAddress (i + 1) (fromMaybe "" $ genSaplingSpendingKey s 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)
-- | 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