diff --git a/CHANGELOG.md b/CHANGELOG.md index 6a768c4..fff58dc 100644 --- a/CHANGELOG.md +++ b/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 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 diff --git a/librustzcash-wrapper/src/lib.rs b/librustzcash-wrapper/src/lib.rs index ce35b57..649b699 100644 --- a/librustzcash-wrapper/src/lib.rs +++ b/librustzcash-wrapper/src/lib.rs @@ -703,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 = 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 14bfc45..97ad03b 100644 --- a/src/C/Zcash.chs +++ b/src/C/Zcash.chs @@ -156,3 +156,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 9d33959..22a82c2 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 = @@ -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 diff --git a/src/ZcashHaskell/Transparent.hs b/src/ZcashHaskell/Transparent.hs index f7f2a48..210ead9 100644 --- a/src/ZcashHaskell/Transparent.hs +++ b/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 = diff --git a/src/ZcashHaskell/Types.hs b/src/ZcashHaskell/Types.hs index a56df2f..f86f368 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 @@ -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) diff --git a/test/Spec.hs b/test/Spec.hs index c6d5086..164329d 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 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 @@ -52,6 +55,7 @@ import ZcashHaskell.Types , CoinType(..) , DecodedNote(..) , OrchardAction(..) + , Phrase(..) , RawData(..) , RawTxResponse(..) , ShieldedOutput(..) @@ -462,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 = @@ -562,3 +560,41 @@ main = do 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 diff --git a/zcash-haskell.cabal b/zcash-haskell.cabal index 057210b..ec49d03 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.4.0 synopsis: Utilities to interact with the Zcash blockchain description: Please see the README on the repo at category: Blockchain @@ -74,6 +74,8 @@ test-suite zcash-haskell-test , haskoin-core , hexstring , hspec + , QuickCheck + , quickcheck-transformer , text , zcash-haskell , binary