Merge branch 'dev040' into rvv040

x

CHANGELOG.md

@@ -17,11 +17,20 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 - Function to encode unified addresses from receivers
 - Function to generate an Orchard spending key
 - Constants for Zcash protocol
+- Types for Spending Keys and Receivers for Sapling and Orchard
+- Function to generate an Orchard receiver
 
 ### Changed
 
 - Update installation to `cabal`
-- Updated `bech32` Rust crate to 0.11
+- Updated Rust crates:
+	- `bech32` to 0.11
+	- `orchard` to 0.7.0
+	- `zcash_note_encryption` to 0.4.0
+	- `zcash_primitives` to 0.13.0
+	- `zcash_client_backend` to 0.10.0
+	- `zip32` to 0.1.0
+- Changed the `UnifiedAddress` to allow for optional shielded receivers
 
 ### Removed
 

cabal.project

@@ -1,4 +1,5 @@
 packages: ./*.cabal
+
 with-compiler: ghc-9.4.8
 
 source-repository-package

cabal.project.freeze

@@ -0,0 +1,207 @@
+active-repositories: hackage.haskell.org:merge
+constraints: any.Cabal ==3.8.1.0,
+             any.Cabal-syntax ==3.8.1.0,
+             any.HUnit ==1.6.2.0,
+             any.OneTuple ==0.4.1.1,
+             any.QuickCheck ==2.14.3,
+             QuickCheck -old-random +templatehaskell,
+             any.StateVar ==1.2.2,
+             any.aeson ==2.2.1.0,
+             aeson +ordered-keymap,
+             any.alex ==3.5.1.0,
+             any.ansi-terminal ==1.1,
+             ansi-terminal -example,
+             any.ansi-terminal-types ==1.1,
+             any.appar ==0.1.8,
+             any.array ==0.5.4.0,
+             any.asn1-encoding ==0.9.6,
+             any.asn1-parse ==0.9.5,
+             any.asn1-types ==0.3.4,
+             any.assoc ==1.1,
+             assoc +tagged,
+             any.async ==2.2.5,
+             async -bench,
+             any.attoparsec ==0.14.4,
+             attoparsec -developer,
+             any.attoparsec-aeson ==2.2.0.1,
+             any.base ==4.17.2.1,
+             any.base-orphans ==0.9.1,
+             any.base16 ==1.0,
+             any.base16-bytestring ==1.0.2.0,
+             any.base58-bytestring ==0.1.0,
+             any.base64-bytestring ==1.2.1.0,
+             any.basement ==0.0.16,
+             any.bifunctors ==5.6.1,
+             bifunctors +tagged,
+             any.binary ==0.8.9.1,
+             any.binary-orphans ==1.0.4.1,
+             any.bitvec ==1.1.5.0,
+             bitvec +simd,
+             any.blaze-builder ==0.4.2.3,
+             any.borsh ==0.3.0,
+             any.byteorder ==1.0.4,
+             any.bytes ==0.17.3,
+             any.bytestring ==0.11.5.3,
+             any.c2hs ==0.28.8,
+             c2hs +base3 -regression,
+             any.call-stack ==0.4.0,
+             any.case-insensitive ==1.2.1.0,
+             any.cborg ==0.2.10.0,
+             cborg +optimize-gmp,
+             any.cereal ==0.5.8.3,
+             cereal -bytestring-builder,
+             any.colour ==2.3.6,
+             any.comonad ==5.0.8,
+             comonad +containers +distributive +indexed-traversable,
+             any.conduit ==1.3.5,
+             any.conduit-extra ==1.3.6,
+             any.containers ==0.6.7,
+             any.contravariant ==1.5.5,
+             contravariant +semigroups +statevar +tagged,
+             any.cookie ==0.5.0,
+             any.crypton ==0.34,
+             crypton -check_alignment +integer-gmp -old_toolchain_inliner +support_aesni +support_deepseq +support_pclmuldq +support_rdrand -support_sse +use_target_attributes,
+             any.crypton-connection ==0.3.2,
+             any.crypton-x509 ==1.7.6,
+             any.crypton-x509-store ==1.6.9,
+             any.crypton-x509-system ==1.6.7,
+             any.crypton-x509-validation ==1.6.12,
+             any.cryptonite ==0.30,
+             cryptonite -check_alignment +integer-gmp -old_toolchain_inliner +support_aesni +support_deepseq -support_pclmuldq +support_rdrand -support_sse +use_target_attributes,
+             any.data-default ==0.7.1.1,
+             any.data-default-class ==0.1.2.0,
+             any.data-default-instances-containers ==0.0.1,
+             any.data-default-instances-dlist ==0.0.1,
+             any.data-default-instances-old-locale ==0.0.1,
+             any.data-fix ==0.3.2,
+             any.deepseq ==1.4.8.0,
+             any.directory ==1.3.7.1,
+             any.distributive ==0.6.2.1,
+             distributive +semigroups +tagged,
+             any.dlist ==1.0,
+             dlist -werror,
+             any.entropy ==0.4.1.10,
+             entropy -donotgetentropy,
+             any.envy ==2.1.2.0,
+             any.exceptions ==0.10.5,
+             any.filepath ==1.4.2.2,
+             any.foldable1-classes-compat ==0.1,
+             foldable1-classes-compat +tagged,
+             any.foreign-rust ==0.1.0,
+             any.generically ==0.1.1,
+             any.generics-sop ==0.5.1.4,
+             any.ghc-bignum ==1.3,
+             any.ghc-boot-th ==9.4.8,
+             any.ghc-prim ==0.9.1,
+             any.half ==0.3.1,
+             any.happy ==1.20.1.1,
+             any.hashable ==1.4.3.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.hourglass ==0.2.12,
+             any.hsc2hs ==0.68.10,
+             hsc2hs -in-ghc-tree,
+             any.hspec ==2.11.7,
+             any.hspec-core ==2.11.7,
+             any.hspec-discover ==2.11.7,
+             any.hspec-expectations ==0.8.4,
+             any.http-client ==0.7.16,
+             http-client +network-uri,
+             any.http-client-tls ==0.3.6.3,
+             any.http-conduit ==2.3.8.3,
+             http-conduit +aeson,
+             any.http-types ==0.12.4,
+             any.indexed-traversable ==0.1.3,
+             any.indexed-traversable-instances ==0.1.1.2,
+             any.integer-conversion ==0.1.0.1,
+             any.integer-gmp ==1.1,
+             any.integer-logarithms ==1.0.3.1,
+             integer-logarithms -check-bounds +integer-gmp,
+             any.iproute ==1.7.12,
+             any.language-c ==0.9.3,
+             language-c -allwarnings +iecfpextension +usebytestrings,
+             any.memory ==0.18.0,
+             memory +support_bytestring +support_deepseq,
+             any.mime-types ==0.1.2.0,
+             any.mono-traversable ==1.0.17.0,
+             any.mtl ==2.2.2,
+             any.murmur3 ==1.0.5,
+             any.network ==3.1.4.0,
+             network -devel,
+             any.network-uri ==2.6.4.2,
+             any.old-locale ==1.0.0.7,
+             any.old-time ==1.1.0.4,
+             any.parsec ==3.1.16.1,
+             any.pem ==0.2.4,
+             any.pretty ==1.1.3.6,
+             any.primitive ==0.9.0.0,
+             any.process ==1.6.18.0,
+             any.quickcheck-io ==0.2.0,
+             any.random ==1.2.1.2,
+             any.regex-base ==0.94.0.2,
+             any.regex-compat ==0.95.2.1,
+             any.regex-posix ==0.96.0.1,
+             regex-posix -_regex-posix-clib,
+             any.resourcet ==1.3.0,
+             any.rts ==1.0.2,
+             any.safe ==0.3.21,
+             any.scientific ==0.3.7.0,
+             scientific -bytestring-builder -integer-simple,
+             any.secp256k1-haskell ==1.1.0,
+             any.semialign ==1.3,
+             semialign +semigroupoids,
+             any.semigroupoids ==6.0.0.1,
+             semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
+             any.serialise ==0.2.6.1,
+             serialise +newtime15,
+             any.socks ==0.6.1,
+             any.sop-core ==0.5.0.2,
+             any.split ==0.2.5,
+             any.splitmix ==0.1.0.5,
+             splitmix -optimised-mixer,
+             any.stm ==2.5.1.0,
+             any.streaming-commons ==0.2.2.6,
+             streaming-commons -use-bytestring-builder,
+             any.strict ==0.5,
+             any.string-conversions ==0.4.0.1,
+             any.tagged ==0.8.8,
+             tagged +deepseq +transformers,
+             any.template-haskell ==2.19.0.0,
+             any.text ==2.0.2,
+             any.text-iso8601 ==0.1,
+             any.text-short ==0.1.5,
+             text-short -asserts,
+             any.tf-random ==0.5,
+             any.th-abstraction ==0.6.0.0,
+             any.th-compat ==0.1.4,
+             any.these ==1.2,
+             any.time ==1.12.2,
+             any.time-compat ==1.9.6.1,
+             time-compat -old-locale,
+             any.tls ==2.0.1,
+             tls -devel,
+             any.transformers ==0.5.6.2,
+             any.transformers-compat ==0.7.2,
+             transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
+             any.typed-process ==0.2.11.1,
+             any.unix ==2.7.3,
+             any.unix-time ==0.4.12,
+             any.unliftio-core ==0.2.1.0,
+             any.unordered-containers ==0.2.20,
+             unordered-containers -debug,
+             any.utf8-string ==1.0.2,
+             any.uuid-types ==1.0.5.1,
+             any.vector ==0.13.1.0,
+             vector +boundschecks -internalchecks -unsafechecks -wall,
+             any.vector-algorithms ==0.9.0.1,
+             vector-algorithms +bench +boundschecks -internalchecks -llvm +properties -unsafechecks,
+             any.vector-stream ==0.1.0.1,
+             any.void ==0.7.3,
+             void -safe,
+             any.wide-word ==0.1.6.0,
+             any.witherable ==0.4.2,
+             any.zlib ==0.7.0.0,
+             zlib -bundled-c-zlib +non-blocking-ffi +pkg-config
+index-state: hackage.haskell.org 2024-03-06T20:26:39Z

librustzcash-wrapper/src/lib.rs

@@ -54,7 +54,7 @@ use zcash_client_backend::keys::{
     sapling::ExtendedFullViewingKey,
     sapling::ExtendedSpendingKey};
 
-use zcash_primitives::zip32::AccountId;
+use zcash_primitives::zip32::{ AccountId, DiversifierIndex };
 use std::slice;
 
 use orchard::{
@@ -621,27 +621,68 @@ pub extern "C" fn rust_wrapper_recover_seed(
 pub extern "C" fn rust_wrapper_sapling_spendingkey(
     iseed: *const u8,
     iseed_len: usize,
-    coin_type: u32,
-    acc_id: u32,
     out: *mut u8,
     out_len: &mut usize
     ){
-        println!("From Rust\n=========");
+    println!("Starting extended spending key generation....");
     let seed: Vec<u8> = marshall_from_haskell_var(iseed, iseed_len, RW);
-    if  ( seed.len() <= 0 ) {
-        println!("Seed error, returning a null vector...");
+    if  ( seed.len() != 64 ) {
+        // invalid seed length 
         marshall_to_haskell_var(&vec![0], out, out_len, RW);
     } else {
-        println!("Seed in rust : {:?}\n", seed);
-        println!("Coin Type -> {}\nAccount Id -> {}",coin_type,acc_id);
+        // Obtain the ExtendedSpendingKey using the seed
+        // Returns a byte array (169 bytes)
         let su8 = &seed;
         let seedu8 : &[u8] = &su8;
+        println!("Seed : {:?}\n", &seedu8);
         let extsk: ExtendedSpendingKey = sapling::ExtendedSpendingKey::master(&seedu8); 
         let extsk_bytes = extsk.to_bytes().to_vec(); 
         marshall_to_haskell_var(&extsk_bytes, out, out_len, RW);
     }
 }
 
+#[no_mangle]
+pub extern "C" fn rust_wrapper_sapling_paymentaddress(
+    extspk: *const u8,
+    extspk_len: usize,
+//    divIx: u32,
+    out: *mut u8,
+    out_len: &mut usize
+    ){
+    let divIx : u32 = 2;
+    println!("Starting paymentAddress generation....");
+    let extspkb: Vec<u8> = marshall_from_haskell_var(extspk, extspk_len, RW);
+    if ( extspkb.len() != 169 ) {
+        // invalid ExtendedSpenndingKey Array length 
+        println!("Invalid ExtendedSpendingKey....");
+        marshall_to_haskell_var(&vec![0], out, out_len, RW);
+    } else {
+        // Process 
+        println!("Extended Spending Key validated, continue ....");
+        let extspkbu8 = &extspkb;
+        let xsku8 : &[u8] = &extspkbu8;
+        let xsk = match sapling::ExtendedSpendingKey::from_bytes(&xsku8) {
+                Ok ( x ) => x, 
+                Err ( err ) => {
+                    // Error recovering ExtendedSpendingKey from bytes
+                    marshall_to_haskell_var(&vec![0], out, out_len, RW);
+                    return        
+                }
+            };
+        // Obtain the DiversifiableFullViewingKey from ExtendedSpendingKey   
+        let dfvk = xsk.to_diversifiable_full_viewing_key();
+        // Obtain the Address from the DiversifiableFullViewingKey
+//        println!("dfvk -> \n{:?}", dfvk);
+//        let divIndex : DiversifierIndex  = divIx.into();
+//        println!("divIndex -> {:?}", divIndex);
+        let (divIx, paddress) = dfvk.default_address();
+        println!("Rust pmtAddress - \n{:?}\n\nRust Diversifier - \n{:?}\n", paddress, divIx);
+        let pmtAddress = paddress.to_bytes();
+        println!("\nRust pntAddress as byte array -\n{:?}\n", pmtAddress);
+        marshall_to_haskell_var(&pmtAddress.to_vec(), out, out_len, RW);
+    }
+}
+
 #[no_mangle]
 pub extern "C" fn rust_wrapper_derive_orchard_spending_key(
     seed: *const u8,
@@ -662,3 +703,19 @@ pub extern "C" fn rust_wrapper_derive_orchard_spending_key(
         }
     }
 }
+
+#[no_mangle]
+pub extern "C" fn rust_wrapper_derive_orchard_receiver(
+    spend_key: *const u8,
+    spend_key_len: usize,
+    add_id: u32,
+    out: *mut u8,
+    out_len: &mut usize
+    ){
+    let sk_in: Vec<u8> = marshall_from_haskell_var(spend_key, spend_key_len, RW);
+    let sk = SpendingKey::from_bytes(sk_in[0..32].try_into().unwrap()).unwrap();
+    let fvk = FullViewingKey::from(&sk);
+    let o_rec = fvk.address_at(add_id, Scope::External);
+    marshall_to_haskell_var(&o_rec.to_raw_address_bytes().to_vec(), out, out_len, RW);
+
+}

src/C/Zcash.chs

@@ -136,8 +136,13 @@ import ZcashHaskell.Types
 
 {# fun unsafe rust_wrapper_sapling_spendingkey as rustWrapperSaplingSpendingkey
      { toBorshVar* `BS.ByteString'&
-     , `Word32'
-     , `Word32'
+     , getVarBuffer `Buffer (BS.ByteString)'&
+     }
+  -> `()'
+#}
+
+{# fun unsafe rust_wrapper_sapling_paymentaddress as rustWrapperPaymentAddress
+     { toBorshVar* `BS.ByteString'&
      , getVarBuffer `Buffer (BS.ByteString)'&
      }
   -> `()'
@@ -151,3 +156,11 @@ import ZcashHaskell.Types
      }
   -> `()'
 #}
+
+{# fun unsafe rust_wrapper_derive_orchard_receiver as rustWrapperGenOrchardReceiver
+     { toBorshVar* `BS.ByteString'&
+     , `Word32'
+     , getVarBuffer `Buffer (BS.ByteString)'&
+     }
+  -> `()'
+#}

src/ZcashHaskell/Orchard.hs

@@ -18,7 +18,8 @@
 module ZcashHaskell.Orchard where
 
 import C.Zcash
-  ( rustWrapperGenOrchardSpendKey
+  ( rustWrapperGenOrchardReceiver
+  , rustWrapperGenOrchardSpendKey
   , rustWrapperOrchardCheck
   , rustWrapperOrchardNoteDecode
   , rustWrapperUADecode
@@ -34,7 +35,8 @@ import ZcashHaskell.Types
 import ZcashHaskell.Utils (encodeBech32m, f4Jumble)
 
 -- | Derives an Orchard spending key for the given seed and account ID
-genOrchardSpendingKey :: Seed -> CoinType -> AccountId -> Maybe BS.ByteString
+genOrchardSpendingKey ::
+     Seed -> CoinType -> AccountId -> Maybe OrchardSpendingKey
 genOrchardSpendingKey s coinType accountId =
   if BS.length k /= 32
     then Nothing
@@ -47,6 +49,17 @@ genOrchardSpendingKey s coinType accountId =
         (getValue coinType)
         (fromIntegral accountId)
 
+-- | Derives an Orchard receiver for the given spending key and index
+genOrchardReceiver :: Int -> OrchardSpendingKey -> Maybe OrchardReceiver
+genOrchardReceiver i osk =
+  if BS.length k /= 43
+    then Nothing
+    else Just k
+  where
+    k =
+      withPureBorshVarBuffer $
+      rustWrapperGenOrchardReceiver osk (fromIntegral i)
+
 -- | Checks if given bytestring is a valid encoded unified address
 isValidUnifiedAddress :: BS.ByteString -> Maybe UnifiedAddress
 isValidUnifiedAddress str =
@@ -63,8 +76,12 @@ isValidUnifiedAddress str =
     makeUA x =
       UnifiedAddress
         whichNet
-        (raw_o x)
-        (raw_s x)
+        (if BS.length (raw_o x) == 43
+           then Just (raw_o x)
+           else Nothing)
+        (if BS.length (raw_s x) == 43
+           then Just (raw_s x)
+           else Nothing)
         (if not (BS.null (raw_t x))
            then Just $ TransparentAddress P2PKH whichNet (raw_t x)
            else if not (BS.null (raw_to x))
@@ -77,26 +94,29 @@ encodeUnifiedAddress ua = encodeBech32m (E.encodeUtf8 hr) b
   where
     hr =
       case ua_net ua of
-        MainNet -> "u"
-        TestNet -> "utest"
+        MainNet -> uniPaymentAddressHrp
+        TestNet -> uniTestPaymentAddressHrp
     b = f4Jumble $ tReceiver <> sReceiver <> oReceiver <> padding
     tReceiver =
       case t_rec ua of
         Nothing -> BS.empty
         Just t ->
           case ta_type t of
-            P2SH -> packReceiver 0x01 $ ta_bytes t
-            P2PKH -> packReceiver 0x00 $ 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
-    packReceiver :: Word8 -> BS.ByteString -> BS.ByteString
-    packReceiver typeCode receiver =
-      if BS.length receiver > 1
-        then BS.singleton typeCode `BS.append`
-             (BS.singleton . toEnum . BS.length) receiver `BS.append`
-             receiver
-        else BS.empty
+    packReceiver :: Word8 -> Maybe BS.ByteString -> BS.ByteString
+    packReceiver typeCode receiver' =
+      case receiver' of
+        Just receiver ->
+          if BS.length receiver > 1
+            then BS.singleton typeCode `BS.append`
+                 (BS.singleton . toEnum . BS.length) receiver `BS.append`
+                 receiver
+            else BS.empty
+        Nothing -> BS.empty
 
 -- | Attempts to decode the given bytestring into a Unified Full Viewing Key
 decodeUfvk :: BS.ByteString -> Maybe UnifiedFullViewingKey

src/ZcashHaskell/Sapling.hs

@@ -22,6 +22,7 @@ import C.Zcash
   , rustWrapperSaplingCheck
   , rustWrapperSaplingNoteDecode
   , rustWrapperSaplingSpendingkey
+  , rustWrapperPaymentAddress
   , rustWrapperSaplingVkDecode
   , rustWrapperTxParse
   )
@@ -92,7 +93,14 @@ instance FromJSON RawTxResponse where
           pure $ RawTxResponse i h (getShieldedOutputs h) a ht c b
 --
 -- | Attempts to obtain a sapling SpendinKey using a HDSeed, a Coin Type and an Account ID
-genSaplingSpendingKey :: BS.ByteString -> Word32-> AccountId -> BS.ByteString
-genSaplingSpendingKey seed coin_type account_id = do
-      let res = withPureBorshVarBuffer (rustWrapperSaplingSpendingkey seed (fromIntegral coin_type) (fromIntegral account_id) )
+genSaplingSpendingKey :: BS.ByteString -> BS.ByteString
+genSaplingSpendingKey seed = do
+      let res = withPureBorshVarBuffer (rustWrapperSaplingSpendingkey seed )
       res
+--
+-- | Attempts to generate a sapling Payment Address using an ExtendedSpendingKey 
+-- | and a Diversifier Index 
+genSaplingPaymentAddress :: BS.ByteString -> BS.ByteString
+genSaplingPaymentAddress extspk = do
+      let pmtaddress = withPureBorshVarBuffer (rustWrapperPaymentAddress extspk )
+      pmtaddress

src/ZcashHaskell/Transparent.hs

@@ -26,6 +26,7 @@ import ZcashHaskell.Types
   ( TransparentAddress(..)
   , TransparentType(..)
   , ZcashNet(..)
+  , getTransparentPrefix
   )
 
 import Haskoin.Crypto.Keys.Extended
@@ -34,15 +35,7 @@ import Crypto.Secp256k1
 
 encodeTransparent :: TransparentAddress -> T.Text
 encodeTransparent t =
-  case ta_type t of
-    P2SH ->
-      case ta_net t of
-        MainNet -> encodeTransparent' (0x1c, 0xbd) $ ta_bytes t
-        _ -> encodeTransparent' (0x1c, 0xba) $ ta_bytes t
-    P2PKH ->
-      case ta_net t of
-        MainNet -> encodeTransparent' (0x1c, 0xb8) $ ta_bytes t
-        _ -> encodeTransparent' (0x1d, 0x25) $ ta_bytes t
+  encodeTransparent' (getTransparentPrefix (ta_net t) (ta_type t)) $ ta_bytes t
   where
     encodeTransparent' :: (Word8, Word8) -> BS.ByteString -> T.Text
     encodeTransparent' (a, b) h =

src/ZcashHaskell/Types.hs

@@ -45,6 +45,18 @@ 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
+
+-- | 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
@@ -64,11 +76,12 @@ data ZcashNet
 type AccountId = Int
 
 -- ** Constants
--- | Types for coin types on the different networks
+-- | Type for coin types on the different networks
 data CoinType
   = MainNetCoin
   | TestNetCoin
   | RegTestNetCoin
+  deriving (Eq, Prelude.Show, Ord)
 
 getValue :: CoinType -> Word32
 getValue c =
@@ -77,6 +90,45 @@ getValue c =
     TestNetCoin -> 1
     RegTestNetCoin -> 1
 
+-- | Constants for Sapling Human-readable part
+sapExtSpendingKeyHrp = "secret-extended-key-main" :: String
+
+sapExtFullViewingKeyHrp = "zxviews" :: String
+
+sapPaymentAddressHrp = "zs" :: String
+
+sapTestExtSpendingKeyHrp = "secret-extended-key-test" :: String
+
+sapTestExtFullViewingKeyHrp = "zxviewtestsapling" :: String
+
+sapTestPaymentAddressHrp = "ztestsapling" :: String
+
+-- | Constants for Unified Human-readable part
+uniPaymentAddressHrp = "u" :: T.Text
+
+uniFullViewingKeyHrp = "uview" :: T.Text
+
+uniIncomingViewingKeyHrp = "uivk" :: T.Text
+
+uniTestPaymentAddressHrp = "utest" :: T.Text
+
+uniTestFullViewingKeyHrp = "uviewtest" :: T.Text
+
+uniTestIncomingViewingKeyHrp = "uivktest" :: T.Text
+
+-- | Function to get the Base58 prefix for encoding a 'TransparentAddress'
+getTransparentPrefix :: ZcashNet -> TransparentType -> (Word8, Word8)
+getTransparentPrefix n t =
+  case t of
+    P2SH ->
+      case n of
+        MainNet -> (0x1c, 0xbd)
+        _ -> (0x1c, 0xba)
+    P2PKH ->
+      case n of
+        MainNet -> (0x1c, 0xb8)
+        _ -> (0x1d, 0x25)
+
 -- * RPC
 -- | A type to model Zcash RPC calls
 data RpcCall = RpcCall
@@ -227,19 +279,19 @@ instance FromJSON ShieldedOutput where
 -- * Orchard
 -- | Type to represent a Unified Address
 data UnifiedAddress = UnifiedAddress
-  { ua_net :: ZcashNet
-  , o_rec :: BS.ByteString
-  , s_rec :: BS.ByteString
-  , t_rec :: Maybe TransparentAddress
+  { ua_net :: !ZcashNet
+  , o_rec :: !(Maybe OrchardReceiver)
+  , s_rec :: !(Maybe SaplingReceiver)
+  , t_rec :: !(Maybe TransparentAddress)
   } deriving (Prelude.Show, Eq, Read)
 
 -- | Helper type for marshalling UAs 
 data RawUA = RawUA
-  { raw_net :: Word8
-  , raw_o :: BS.ByteString
-  , raw_s :: BS.ByteString
-  , raw_t :: BS.ByteString
-  , raw_to :: BS.ByteString
+  { raw_net :: !Word8
+  , raw_o :: !BS.ByteString
+  , raw_s :: !BS.ByteString
+  , raw_t :: !BS.ByteString
+  , raw_to :: !BS.ByteString
   } deriving stock (Eq, Prelude.Show, GHC.Generic)
     deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo)
     deriving anyclass (Data.Structured.Show)

test/Spec.hs

@@ -17,6 +17,7 @@
 
 -}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeSynonymInstances #-}
 
 import C.Zcash (rustWrapperUADecode)
 import Control.Monad.IO.Class (liftIO)
@@ -34,6 +35,8 @@ import qualified Data.Text.Lazy.IO as LTIO
 
 import GHC.Float.RealFracMethods (properFractionDoubleInteger)
 import Test.Hspec
+import Test.Hspec.QuickCheck
+import Test.QuickCheck
 import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed)
 import ZcashHaskell.Orchard
 import ZcashHaskell.Sapling
@@ -43,6 +46,7 @@ import ZcashHaskell.Sapling
   , isValidShieldedAddress
   , matchSaplingAddress
   , genSaplingSpendingKey
+  , genSaplingPaymentAddress 
   )
 import ZcashHaskell.Transparent 
   --(encodeTransparent)
@@ -51,6 +55,7 @@ import ZcashHaskell.Types
   , CoinType(..)
   , DecodedNote(..)
   , OrchardAction(..)
+  , Phrase(..)
   , RawData(..)
   , RawTxResponse(..)
   , ShieldedOutput(..)
@@ -461,18 +466,12 @@ 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
-      it "Generate phrase" $ do
-        p <- generateWalletSeedPhrase
-        BS.length p `shouldNotBe` 0
-      it "Derive seed" $ do
-        p <- generateWalletSeedPhrase
-        let s = getWalletSeed p
-        maybe 0 BS.length s `shouldBe` 64
-      it "Generate Orchard spending key" $ do
-        p <- generateWalletSeedPhrase
-        let s = getWalletSeed p
-        genOrchardSpendingKey (fromMaybe "" s) MainNetCoin 1 `shouldNotBe`
-          Nothing
+      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
     describe "Address tests" $ do
       it "Encode transparent" $ do
         let ua =
@@ -531,11 +530,71 @@ main = do
                    241, 243, 172, 178,
                    104, 81, 159, 144
                   ] :: [Word8]
-          let cointype  =  getValue TestNetCoin
-          let account = 0 :: AccountId
-          let msg = genSaplingSpendingKey (word8ArrayToByteString hdseed) cointype account
+          let msg = genSaplingSpendingKey (word8ArrayToByteString hdseed)
           let msgArr = BS.unpack msg
           if (length msgArr) == 169
                   then True
                   else False
---          msgArr `shouldBe` "It's working."
+    describe "Sapling Payment Address generation test" $ do
+        it "Call genSaplingPaymentAddress" $ do
+          let hdseed1 =  [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 msg1 = genSaplingSpendingKey (word8ArrayToByteString hdseed1)
+          let pmtaddress = genSaplingPaymentAddress  msg1 --(word8ArrayToByteString hdseed1)
+          let msgArr = BS.unpack pmtaddress
+          if (length msgArr) == 43
+                  then True
+                  else False
+
+-- | Properties
+prop_PhraseLength :: Int -> Property
+prop_PhraseLength i =
+  ioProperty $ do
+    p <- generateWalletSeedPhrase
+    return $ BS.length p >= 95
+
+prop_SeedLength :: Int -> Property
+prop_SeedLength i =
+  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_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
+
+-- | Generators
+genOrcArgs :: Gen (CoinType, Int, Int)
+genOrcArgs = do
+  i <- arbitrarySizedNatural
+  j <- arbitrarySizedNatural
+  c <- elements [MainNetCoin, TestNetCoin, RegTestNetCoin]
+  return (c, i, j)
+-- | Arbitrary instances

zcash-haskell.cabal

@@ -5,7 +5,7 @@ cabal-version: 3.0
 -- see: https://github.com/sol/hpack
 
 name:           zcash-haskell
-version:        0.4.3.0
+version:        0.4.4.0
 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
@@ -74,6 +74,8 @@ test-suite zcash-haskell-test
     , haskoin-core
     , hexstring
     , hspec
+    , QuickCheck
+    , quickcheck-transformer
     , text
     , zcash-haskell
     , binary