diff --git a/cabal.project b/cabal.project index a64c126..989ae5a 100644 --- a/cabal.project +++ b/cabal.project @@ -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 diff --git a/cabal.project.freeze b/cabal.project.freeze index 49f5987..5cf3ed7 100644 --- a/cabal.project.freeze +++ b/cabal.project.freeze @@ -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, diff --git a/librustzcash-wrapper/src/lib.rs b/librustzcash-wrapper/src/lib.rs index c2b2607..fa8e042 100644 --- a/librustzcash-wrapper/src/lib.rs +++ b/librustzcash-wrapper/src/lib.rs @@ -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 = 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); + } } } } diff --git a/src/ZcashHaskell/Orchard.hs b/src/ZcashHaskell/Orchard.hs index 22a82c2..26c9fa1 100644 --- a/src/ZcashHaskell/Orchard.hs +++ b/src/ZcashHaskell/Orchard.hs @@ -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 diff --git a/src/ZcashHaskell/Sapling.hs b/src/ZcashHaskell/Sapling.hs index d4eaa71..b9fac6b 100644 --- a/src/ZcashHaskell/Sapling.hs +++ b/src/ZcashHaskell/Sapling.hs @@ -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 diff --git a/src/ZcashHaskell/Transparent.hs b/src/ZcashHaskell/Transparent.hs index 210ead9..8c2bf89 100644 --- a/src/ZcashHaskell/Transparent.hs +++ b/src/ZcashHaskell/Transparent.hs @@ -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" diff --git a/src/ZcashHaskell/Types.hs b/src/ZcashHaskell/Types.hs index 7c14558..ad6bc13 100644 --- a/src/ZcashHaskell/Types.hs +++ b/src/ZcashHaskell/Types.hs @@ -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 diff --git a/test/Spec.hs b/test/Spec.hs index 6e815b3..37fc16e 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -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) diff --git a/zcash-haskell.cabal b/zcash-haskell.cabal index 19e047d..584e7ba 100644 --- a/zcash-haskell.cabal +++ b/zcash-haskell.cabal @@ -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