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: 39d8da7b11a80269454c2f134a5c834e0f3cb9a7
+  tag: fd1ddce73c0ad18a2a4509a299c6e93f8c6c383d

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.1.0,
+             any.hexstring ==0.12.0,
              any.hourglass ==0.2.12,
              any.hsc2hs ==0.68.10,
              hsc2hs -in-ghc-tree,

librustzcash-wrapper/src/lib.rs

@@ -59,13 +59,12 @@ use zcash_address::{
 };
 
 use zcash_client_backend::keys::sapling::{
-    spending_key,
     ExtendedFullViewingKey,
     ExtendedSpendingKey,
     DiversifiableFullViewingKey
 };
 
-use zcash_primitives::zip32::DiversifierIndex;
+use zcash_primitives::zip32::{ AccountId, DiversifierIndex };
 
 use orchard::{
     Action,
@@ -629,16 +628,23 @@ pub extern "C" fn rust_wrapper_recover_seed(
 
 #[no_mangle]
 pub extern "C" fn rust_wrapper_sapling_spendingkey(
-    seed: *const u8,
-    seed_len: usize,
-    coin_type: u32,
-    acc_id: u32,
+    iseed: *const u8,
+    iseed_len: usize,
+    ix: u32,
     out: *mut u8,
     out_len: &mut usize
     ){
-    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);
+    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);
+    }
 }
 
 #[no_mangle]
@@ -650,18 +656,6 @@ pub extern "C" fn rust_wrapper_sapling_paymentaddress(
     out_len: &mut usize
     ){
     let extspk: Vec<u8> = marshall_from_haskell_var(extspk, extspk_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);
@@ -674,7 +668,6 @@ pub extern "C" fn rust_wrapper_sapling_paymentaddress(
             marshall_to_haskell_var(&vec![0], out, out_len, RW);
         }
     }
-    }
 }
 
 #[no_mangle]

src/C/Zcash.chs

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

src/ZcashHaskell/Orchard.hs

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

src/ZcashHaskell/Sapling.hs

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

src/ZcashHaskell/Transparent.hs

@@ -15,33 +15,27 @@
 --
 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
-  ( AccountId
-  , Seed
-  , TransparentAddress(..)
+  ( TransparentAddress(..)
   , TransparentType(..)
   , ZcashNet(..)
   , getTransparentPrefix
   )
 
-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
+import Data.Word
+import Crypto.Secp256k1
 
-encodeTransparent :: ZcashNet -> TransparentAddress -> T.Text
-encodeTransparent zNet t =
-  encodeTransparent' (getTransparentPrefix zNet (ta_type t)) $
-  toBytes $ ta_bytes t
+encodeTransparent :: TransparentAddress -> T.Text
+encodeTransparent t =
+  encodeTransparent' (getTransparentPrefix (ta_net t) (ta_type t)) $ ta_bytes t
   where
     encodeTransparent' :: (Word8, Word8) -> BS.ByteString -> T.Text
     encodeTransparent' (a, b) h =
@@ -53,20 +47,17 @@ encodeTransparent zNet t =
         checksum = sha256 $ sha256 digest
 
 -- | Attempts to generate an Extended Private Key from a known HDSeed.
-genTransparentPrvKey :: Seed -> AccountId -> IO XPrvKey
-genTransparentPrvKey hdseed i = do
-  let prvKey = makeXPrvKey hdseed
-  ioCtx <- createContext
-  return $ hardSubKey ioCtx prvKey (fromIntegral i)
+genTransparentPrvKey ::
+    BS.ByteString -> XPrvKey
+genTransparentPrvKey hdseed = do
+    makeXPrvKey hdseed
 
--- | Generate a transparent receiver
-genTransparentReceiver :: Int -> XPrvKey -> IO TransparentAddress
-genTransparentReceiver i xprvk = do
+-- | Attempts to obtain an Extended Public Key from a known Extended Private Key
+genTransparentPubKey ::
+    XPrvKey -> IO XPubKey
+genTransparentPubKey xpvk = 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"
+    let xpubk = deriveXPubKey ioCtx xpvk
+    return xpubk
+
+

src/ZcashHaskell/Types.hs

@@ -36,7 +36,6 @@ 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
 --
@@ -46,6 +45,21 @@ 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
@@ -236,19 +250,11 @@ data TransparentType
 -- | Type to represent a transparent Zcash addresses
 data TransparentAddress = TransparentAddress
   { ta_type :: !TransparentType
-  , ta_bytes :: !HexString
+  , ta_net :: !ZcashNet
+  , ta_bytes :: !BS.ByteString
   } 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
@@ -274,12 +280,6 @@ 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

test/Spec.hs

@@ -52,6 +52,8 @@ import ZcashHaskell.Sapling
   , matchSaplingAddress
   )
 import ZcashHaskell.Transparent
+  --(encodeTransparent)
+
 import ZcashHaskell.Types
   ( AccountId
   , BlockResponse(..)
@@ -64,11 +66,8 @@ import ZcashHaskell.Types
   , RawTxResponse(..)
   , Seed(..)
   , ShieldedOutput(..)
-  , TransparentAddress(..)
-  , TransparentType(..)
   , UnifiedAddress(..)
   , UnifiedFullViewingKey(..)
-  , ZcashNet(..)
   , decodeHexText
   , getValue
   )
@@ -475,22 +474,16 @@ 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 distinct" $ \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
-        it "Orchard receivers are distinct" $ \s ->
-          property $ prop_OrchardRecRepeated s
     describe "Address tests" $ do
       it "Encode transparent" $ do
         let ua =
@@ -498,11 +491,8 @@ main = do
         let msg =
               case isValidUnifiedAddress ua of
                 Nothing -> "Bad UA"
-                Just u ->
-                  maybe "No transparent" (encodeTransparent (ua_net u)) $
-                  t_rec u
+                Just u -> maybe "No transparent" encodeTransparent $ 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 =
@@ -796,47 +786,6 @@ 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 =
@@ -860,40 +809,19 @@ prop_OrchardReceiver ::
 prop_OrchardReceiver s c (NonNegative i) (NonNegative j) =
   genOrchardReceiver j (fromMaybe "" $ genOrchardSpendingKey s c i) =/= Nothing
 
-prop_SaplingSpendingKey :: Seed -> CoinType -> NonNegative Int -> Property
-prop_SaplingSpendingKey s c (NonNegative i) =
-  genSaplingSpendingKey s c i =/= Nothing
+prop_SaplingSpendingKey :: Seed -> NonNegative Int -> Property
+prop_SaplingSpendingKey s (NonNegative i) =
+  genSaplingSpendingKey s i =/= Nothing
 
-prop_SaplingReceiver ::
-     Seed -> CoinType -> NonNegative Int -> NonNegative Int -> Property
-prop_SaplingReceiver s c (NonNegative i) (NonNegative j) =
-  genSaplingPaymentAddress i (fromMaybe "" $ genSaplingSpendingKey s c j) =/=
+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 -> 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
+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)

zcash-haskell.cabal

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