From d118a839933d056491ae5e177a453f0441dd6ae9 Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Wed, 6 Mar 2024 13:05:00 -0600 Subject: [PATCH 01/10] Add constants to library --- src/ZcashHaskell/Transparent.hs | 11 ++----- src/ZcashHaskell/Types.hs | 53 ++++++++++++++++++++++++++++++++- 2 files changed, 54 insertions(+), 10 deletions(-) diff --git a/src/ZcashHaskell/Transparent.hs b/src/ZcashHaskell/Transparent.hs index 6de9200..b7bac10 100644 --- a/src/ZcashHaskell/Transparent.hs +++ b/src/ZcashHaskell/Transparent.hs @@ -26,19 +26,12 @@ import ZcashHaskell.Types ( TransparentAddress(..) , TransparentType(..) , ZcashNet(..) + , getTransparentPrefix ) 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 = diff --git a/src/ZcashHaskell/Types.hs b/src/ZcashHaskell/Types.hs index 11668d1..374474d 100644 --- a/src/ZcashHaskell/Types.hs +++ b/src/ZcashHaskell/Types.hs @@ -64,7 +64,7 @@ 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 @@ -77,6 +77,57 @@ getValue c = TestNetCoin -> 1 RegTestNetCoin -> 1 +-- | Type for Sapling Human-readable part +data SaplingHrp + = SapExtSpendingKey + | SapExtFullViewingKey + | SapPaymentAddress + | SapTestExtSpendingKey + | SapTestExtFullViewingKey + | SapTestPaymentAddress + +getSaplingHrp :: SaplingHrp -> String +getSaplingHrp s = + case s of + SapExtSpendingKey -> "secret-extended-key-main" + SapExtFullViewingKey -> "zxviews" + SapPaymentAddress -> "zs" + SapTestExtSpendingKey -> "secret-extended-key-test" + SapTestExtFullViewingKey -> "zxviewtestsapling" + SapTestPaymentAddress -> "ztestsapling" + +-- | Type for Unified Human-readable part +data UnifiedHrp + = UniPaymentAddress + | UniFullViewingKey + | UniIncomingViewingKey + | UniTestPaymentAddress + | UniTestFullViewingKey + | UniTestIncomingViewingKey + +getUnifiedHrp :: UnifiedHrp -> String +getUnifiedHrp s = + case s of + UniPaymentAddress -> "u" + UniFullViewingKey -> "uview" + UniIncomingViewingKey -> "uivk" + UniTestPaymentAddress -> "utest" + UniTestFullViewingKey -> "uviewtest" + UniTestIncomingViewingKey -> "uivktest" + +-- | 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 From b568ee5ff4f93bc822e3f1b943e59c3f3b64174c Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Wed, 6 Mar 2024 15:02:48 -0600 Subject: [PATCH 02/10] Pin dependencies --- cabal.project | 1 + cabal.project.freeze | 207 +++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 208 insertions(+) create mode 100644 cabal.project.freeze diff --git a/cabal.project b/cabal.project index 60a9728..a64c126 100644 --- a/cabal.project +++ b/cabal.project @@ -1,4 +1,5 @@ packages: ./*.cabal + with-compiler: ghc-9.4.8 source-repository-package diff --git a/cabal.project.freeze b/cabal.project.freeze new file mode 100644 index 0000000..49f5987 --- /dev/null +++ b/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 From 977f4e791d0f2f8a3579bbcd760850e61931e9a9 Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Wed, 6 Mar 2024 15:10:26 -0600 Subject: [PATCH 03/10] Implement Unified HRP constants --- src/ZcashHaskell/Orchard.hs | 4 +-- src/ZcashHaskell/Types.hs | 56 +++++++++++++++---------------------- zcash-haskell.cabal | 2 +- 3 files changed, 25 insertions(+), 37 deletions(-) diff --git a/src/ZcashHaskell/Orchard.hs b/src/ZcashHaskell/Orchard.hs index 9d33959..d71ce64 100644 --- a/src/ZcashHaskell/Orchard.hs +++ b/src/ZcashHaskell/Orchard.hs @@ -77,8 +77,8 @@ 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 diff --git a/src/ZcashHaskell/Types.hs b/src/ZcashHaskell/Types.hs index 374474d..f9fe6f2 100644 --- a/src/ZcashHaskell/Types.hs +++ b/src/ZcashHaskell/Types.hs @@ -77,43 +77,31 @@ getValue c = TestNetCoin -> 1 RegTestNetCoin -> 1 --- | Type for Sapling Human-readable part -data SaplingHrp - = SapExtSpendingKey - | SapExtFullViewingKey - | SapPaymentAddress - | SapTestExtSpendingKey - | SapTestExtFullViewingKey - | SapTestPaymentAddress +-- | Constants for Sapling Human-readable part +sapExtSpendingKeyHrp = "secret-extended-key-main" :: String -getSaplingHrp :: SaplingHrp -> String -getSaplingHrp s = - case s of - SapExtSpendingKey -> "secret-extended-key-main" - SapExtFullViewingKey -> "zxviews" - SapPaymentAddress -> "zs" - SapTestExtSpendingKey -> "secret-extended-key-test" - SapTestExtFullViewingKey -> "zxviewtestsapling" - SapTestPaymentAddress -> "ztestsapling" +sapExtFullViewingKeyHrp = "zxviews" :: String --- | Type for Unified Human-readable part -data UnifiedHrp - = UniPaymentAddress - | UniFullViewingKey - | UniIncomingViewingKey - | UniTestPaymentAddress - | UniTestFullViewingKey - | UniTestIncomingViewingKey +sapPaymentAddressHrp = "zs" :: String -getUnifiedHrp :: UnifiedHrp -> String -getUnifiedHrp s = - case s of - UniPaymentAddress -> "u" - UniFullViewingKey -> "uview" - UniIncomingViewingKey -> "uivk" - UniTestPaymentAddress -> "utest" - UniTestFullViewingKey -> "uviewtest" - UniTestIncomingViewingKey -> "uivktest" +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) diff --git a/zcash-haskell.cabal b/zcash-haskell.cabal index e4a2f3b..d6d04ea 100644 --- a/zcash-haskell.cabal +++ b/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.3.1 synopsis: Utilities to interact with the Zcash blockchain description: Please see the README on the repo at category: Blockchain From f1174751fc5eb4f5bb13e103573399b781a4e79b Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Thu, 7 Mar 2024 16:05:59 -0600 Subject: [PATCH 04/10] Add new types for Spending Keys and Receivers --- src/ZcashHaskell/Types.hs | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/src/ZcashHaskell/Types.hs b/src/ZcashHaskell/Types.hs index f9fe6f2..38d190f 100644 --- a/src/ZcashHaskell/Types.hs +++ b/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 From 72e87577a772330b886ef01170c37dda29a0f62d Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Thu, 7 Mar 2024 16:06:33 -0600 Subject: [PATCH 05/10] Add generation of Orchard receivers --- librustzcash-wrapper/src/lib.rs | 16 ++++++++++++++++ src/C/Zcash.chs | 8 ++++++++ src/ZcashHaskell/Orchard.hs | 17 +++++++++++++++-- 3 files changed, 39 insertions(+), 2 deletions(-) diff --git a/librustzcash-wrapper/src/lib.rs b/librustzcash-wrapper/src/lib.rs index 3b7297a..b3806a2 100644 --- a/librustzcash-wrapper/src/lib.rs +++ b/librustzcash-wrapper/src/lib.rs @@ -632,3 +632,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 = 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); + +} diff --git a/src/C/Zcash.chs b/src/C/Zcash.chs index 84a641b..af0582a 100644 --- a/src/C/Zcash.chs +++ b/src/C/Zcash.chs @@ -142,3 +142,11 @@ import ZcashHaskell.Types } -> `()' #} + +{# fun unsafe rust_wrapper_derive_orchard_receiver as rustWrapperGenOrchardReceiver + { toBorshVar* `BS.ByteString'& + , `Word32' + , getVarBuffer `Buffer (BS.ByteString)'& + } + -> `()' +#} diff --git a/src/ZcashHaskell/Orchard.hs b/src/ZcashHaskell/Orchard.hs index d71ce64..4a0f530 100644 --- a/src/ZcashHaskell/Orchard.hs +++ b/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 = From b2f56941a43bfeb2c4f678b52b77b1a14616f993 Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Thu, 7 Mar 2024 16:07:50 -0600 Subject: [PATCH 06/10] Bump version --- CHANGELOG.md | 2 ++ zcash-haskell.cabal | 2 +- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 6a768c4..2a39f77 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -17,6 +17,8 @@ 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 diff --git a/zcash-haskell.cabal b/zcash-haskell.cabal index d6d04ea..b6675d1 100644 --- a/zcash-haskell.cabal +++ b/zcash-haskell.cabal @@ -5,7 +5,7 @@ cabal-version: 3.0 -- see: https://github.com/sol/hpack name: zcash-haskell -version: 0.4.3.1 +version: 0.4.3.2 synopsis: Utilities to interact with the Zcash blockchain description: Please see the README on the repo at category: Blockchain From 6c2dfa02fa8a6be6975ecfc8ed0a730b5e57e81c Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Fri, 8 Mar 2024 12:44:10 -0600 Subject: [PATCH 07/10] Implement QuickCheck tests for Orchard components --- src/ZcashHaskell/Types.hs | 1 + test/Spec.hs | 60 +++++++++++++++++++++++++++++++-------- zcash-haskell.cabal | 2 ++ 3 files changed, 51 insertions(+), 12 deletions(-) diff --git a/src/ZcashHaskell/Types.hs b/src/ZcashHaskell/Types.hs index 38d190f..4bd0cd9 100644 --- a/src/ZcashHaskell/Types.hs +++ b/src/ZcashHaskell/Types.hs @@ -81,6 +81,7 @@ data CoinType = MainNetCoin | TestNetCoin | RegTestNetCoin + deriving (Eq, Prelude.Show, Ord) getValue :: CoinType -> Word32 getValue c = diff --git a/test/Spec.hs b/test/Spec.hs index c06a689..a4abbf2 100644 --- a/test/Spec.hs +++ b/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 Data.Word 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 @@ -49,6 +52,7 @@ import ZcashHaskell.Types , CoinType(..) , DecodedNote(..) , OrchardAction(..) + , Phrase(..) , RawData(..) , RawTxResponse(..) , ShieldedOutput(..) @@ -448,18 +452,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 = @@ -469,3 +467,41 @@ main = do Nothing -> "Bad UA" Just u -> maybe "No transparent" encodeTransparent $ t_rec u msg `shouldBe` "t1LPWuQnjCRH7JAeEErSXKixcUteLJRJjKD" + +-- | 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 diff --git a/zcash-haskell.cabal b/zcash-haskell.cabal index b6675d1..435f12f 100644 --- a/zcash-haskell.cabal +++ b/zcash-haskell.cabal @@ -72,6 +72,8 @@ test-suite zcash-haskell-test , haskoin-core , hexstring , hspec + , QuickCheck + , quickcheck-transformer , text , zcash-haskell pkgconfig-depends: rustzcash_wrapper From 6e31d839635fa94c8ab67c3128460c4b68029908 Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Fri, 8 Mar 2024 13:09:13 -0600 Subject: [PATCH 08/10] Update `UnifiedAddress` to use named types for receivers --- src/ZcashHaskell/Types.hs | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/src/ZcashHaskell/Types.hs b/src/ZcashHaskell/Types.hs index 4bd0cd9..931828e 100644 --- a/src/ZcashHaskell/Types.hs +++ b/src/ZcashHaskell/Types.hs @@ -279,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 :: !OrchardReceiver + , s_rec :: !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) From 9c4e26c9f2ca159c04a1a76216d0e250473c91e0 Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Fri, 8 Mar 2024 13:35:37 -0600 Subject: [PATCH 09/10] Implement initial changes for ZIP-320 Rev1 --- src/ZcashHaskell/Orchard.hs | 29 ++++++++++++++++++----------- src/ZcashHaskell/Types.hs | 4 ++-- 2 files changed, 20 insertions(+), 13 deletions(-) diff --git a/src/ZcashHaskell/Orchard.hs b/src/ZcashHaskell/Orchard.hs index 4a0f530..22a82c2 100644 --- a/src/ZcashHaskell/Orchard.hs +++ b/src/ZcashHaskell/Orchard.hs @@ -76,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)) @@ -98,18 +102,21 @@ encodeUnifiedAddress ua = encodeBech32m (E.encodeUtf8 hr) b 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 diff --git a/src/ZcashHaskell/Types.hs b/src/ZcashHaskell/Types.hs index 931828e..41e41e8 100644 --- a/src/ZcashHaskell/Types.hs +++ b/src/ZcashHaskell/Types.hs @@ -280,8 +280,8 @@ instance FromJSON ShieldedOutput where -- | Type to represent a Unified Address data UnifiedAddress = UnifiedAddress { ua_net :: !ZcashNet - , o_rec :: !OrchardReceiver - , s_rec :: !SaplingReceiver + , o_rec :: !(Maybe OrchardReceiver) + , s_rec :: !(Maybe SaplingReceiver) , t_rec :: !(Maybe TransparentAddress) } deriving (Prelude.Show, Eq, Read) From d3cf05d00eff562427e1c106bff14081b23712af Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Fri, 8 Mar 2024 13:42:18 -0600 Subject: [PATCH 10/10] Update version --- CHANGELOG.md | 9 ++++++++- zcash-haskell.cabal | 2 +- 2 files changed, 9 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 2a39f77..fff58dc 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -23,7 +23,14 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### 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 diff --git a/zcash-haskell.cabal b/zcash-haskell.cabal index 435f12f..11cbd72 100644 --- a/zcash-haskell.cabal +++ b/zcash-haskell.cabal @@ -5,7 +5,7 @@ cabal-version: 3.0 -- see: https://github.com/sol/hpack name: zcash-haskell -version: 0.4.3.2 +version: 0.4.4.0 synopsis: Utilities to interact with the Zcash blockchain description: Please see the README on the repo at category: Blockchain