Zebra Raw Tx deserialization #44
17 changed files with 2626 additions and 997 deletions
135
CHANGELOG.md
135
CHANGELOG.md
|
|
@ -5,6 +5,141 @@ All notable changes to this project will be documented in this file.
|
|||
The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
|
||||
and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).
|
||||
|
||||
## [0.7.8.0]
|
||||
|
||||
## Added
|
||||
|
||||
- New `UnifiedIncomingViewingKey` type
|
||||
- Functions to derive Orchard full viewing key
|
||||
- Functions to derive Sapling full viewing key
|
||||
- Functions to derive transparent "full viewing key"
|
||||
- Functions to encode Unified Full Viewing Keys
|
||||
- Functions to encode Unified Incoming Viewing Keys
|
||||
|
||||
## [0.7.7.0]
|
||||
|
||||
### Changed
|
||||
|
||||
- Updated Rust crates
|
||||
|
||||
## [0.7.6.0]
|
||||
|
||||
### Changed
|
||||
|
||||
- Removed workaround for missing `time` field in Zebra's `getblock` response.
|
||||
|
||||
## [0.7.5.0]
|
||||
|
||||
### Added
|
||||
|
||||
- Sapling commitment node functions
|
||||
- Sapling Merkle path test
|
||||
|
||||
### Changed
|
||||
|
||||
- Upgraded Rust dependencies to latest versions:
|
||||
- `zcash_primitives` 0.19.0
|
||||
- `zcash_client_backend` 0.14.0
|
||||
- `orchard` 0.10.0
|
||||
- `sapling-crypto` 0.3.0
|
||||
- `incrementalmerkletree` 0.7.0
|
||||
- `zip32` 0.1.2
|
||||
|
||||
## [0.7.4.0]
|
||||
|
||||
### Added
|
||||
|
||||
- `MerklePath`
|
||||
|
||||
## [0.7.3.0]
|
||||
|
||||
### Added
|
||||
|
||||
- Function to create an Orchard hash from a note commitment
|
||||
- Function to hash Orchard commitments
|
||||
|
||||
### Changed
|
||||
|
||||
- Modified frontiers to use `HexString` for ommers
|
||||
- Optimized `createTransaction`
|
||||
|
||||
## [0.7.2.0]
|
||||
|
||||
### Changed
|
||||
|
||||
- Modified Sapling commitment trees to use Frontier
|
||||
|
||||
## [0.7.1.1]
|
||||
|
||||
### Added
|
||||
|
||||
- `ToJSON` instance for `BlockResponse`
|
||||
|
||||
### Changed
|
||||
|
||||
- Updated libraries:
|
||||
- conduit
|
||||
- data-fix
|
||||
- happy
|
||||
- happy-lib
|
||||
- http-conduit
|
||||
- iproute
|
||||
- mono-traversable
|
||||
- network
|
||||
- secp256k1-haskell
|
||||
- strict
|
||||
- typed-process
|
||||
|
||||
## [0.7.1.0]
|
||||
|
||||
### Added
|
||||
|
||||
- Type `OrchardFrontier`
|
||||
|
||||
### Changed
|
||||
|
||||
- Modified Orchard commitment trees functions to use Frontier
|
||||
|
||||
## [0.7.0.2]
|
||||
|
||||
### Changed
|
||||
|
||||
- Modified witness update functions to skip the process if no commitments are present
|
||||
|
||||
## [0.7.0.1]
|
||||
|
||||
### Added
|
||||
- New error type `PrivacyPolicyError`
|
||||
|
||||
## [0.7.0.0]
|
||||
|
||||
- Implement `wagyu-zcash-parameters` in Rust bindings
|
||||
|
||||
## [0.6.2.3]
|
||||
|
||||
### Fixed
|
||||
|
||||
- Decoding of unified addresses with no transparent receivers
|
||||
|
||||
## [0.6.2.2]
|
||||
|
||||
- Added JSON instances for `ZcashNet`
|
||||
- Added JSON instances for `Transaction`
|
||||
- Added `ValidAddress`
|
||||
|
||||
## [0.6.2.1]
|
||||
|
||||
### Changed
|
||||
|
||||
- Modified the parsing of raw transactions for shielded outputs
|
||||
- Upgraded to GHC 9.6.5
|
||||
|
||||
## [0.6.2.0]
|
||||
|
||||
### Changed
|
||||
|
||||
- Performance enhancement for transaction creation
|
||||
|
||||
## [0.6.1.1]
|
||||
|
||||
### Added
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
packages: ./*.cabal
|
||||
|
||||
with-compiler: ghc-9.4.8
|
||||
with-compiler: ghc-9.6.5
|
||||
|
||||
source-repository-package
|
||||
type: git
|
||||
|
|
|
|||
|
|
@ -1,40 +1,40 @@
|
|||
active-repositories: hackage.haskell.org:merge
|
||||
constraints: any.Cabal ==3.8.1.0,
|
||||
any.Cabal-syntax ==3.8.1.0,
|
||||
constraints: any.Cabal ==3.10.3.0,
|
||||
any.Cabal-syntax ==3.10.3.0,
|
||||
any.HUnit ==1.6.2.0,
|
||||
any.OneTuple ==0.4.1.1,
|
||||
any.OneTuple ==0.4.2,
|
||||
any.QuickCheck ==2.14.3,
|
||||
QuickCheck -old-random +templatehaskell,
|
||||
any.StateVar ==1.2.2,
|
||||
any.aeson ==2.2.1.0,
|
||||
any.aeson ==2.2.3.0,
|
||||
aeson +ordered-keymap,
|
||||
any.alex ==3.5.1.0,
|
||||
any.ansi-terminal ==1.1,
|
||||
any.ansi-terminal ==1.1.1,
|
||||
ansi-terminal -example,
|
||||
any.ansi-terminal-types ==1.1,
|
||||
any.appar ==0.1.8,
|
||||
any.array ==0.5.4.0,
|
||||
any.array ==0.5.6.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.assoc ==1.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.attoparsec-aeson ==2.2.2.0,
|
||||
any.base ==4.18.2.1,
|
||||
any.base-orphans ==0.9.2,
|
||||
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,
|
||||
any.bifunctors ==5.6.2,
|
||||
bifunctors +tagged,
|
||||
any.binary ==0.8.9.1,
|
||||
any.binary-orphans ==1.0.4.1,
|
||||
any.binary-orphans ==1.0.5,
|
||||
any.bitvec ==1.1.5.0,
|
||||
bitvec +simd,
|
||||
any.blaze-builder ==0.4.2.3,
|
||||
|
|
@ -50,19 +50,20 @@ constraints: any.Cabal ==3.8.1.0,
|
|||
cborg +optimize-gmp,
|
||||
any.cereal ==0.5.8.3,
|
||||
cereal -bytestring-builder,
|
||||
any.character-ps ==0.1,
|
||||
any.colour ==2.3.6,
|
||||
any.comonad ==5.0.8,
|
||||
comonad +containers +distributive +indexed-traversable,
|
||||
any.conduit ==1.3.5,
|
||||
any.conduit ==1.3.6,
|
||||
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,
|
||||
any.crypton ==1.0.0,
|
||||
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-connection ==0.4.1,
|
||||
any.crypton-x509 ==1.7.7,
|
||||
any.crypton-x509-store ==1.6.9,
|
||||
any.crypton-x509-system ==1.6.7,
|
||||
any.crypton-x509-validation ==1.6.12,
|
||||
|
|
@ -73,72 +74,73 @@ constraints: any.Cabal ==3.8.1.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.data-fix ==0.3.4,
|
||||
any.deepseq ==1.4.8.1,
|
||||
any.directory ==1.3.8.4,
|
||||
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.envy ==2.1.3.0,
|
||||
any.exceptions ==0.10.7,
|
||||
any.filepath ==1.4.300.1,
|
||||
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.ghc-boot-th ==9.6.5,
|
||||
any.ghc-prim ==0.10.0,
|
||||
any.half ==0.3.1,
|
||||
any.happy ==1.20.1.1,
|
||||
any.hashable ==1.4.3.0,
|
||||
hashable +integer-gmp -random-initial-seed,
|
||||
any.happy ==2.0.2,
|
||||
any.happy-lib ==2.0.2,
|
||||
any.hashable ==1.4.7.0,
|
||||
hashable -arch-native +integer-gmp -random-initial-seed,
|
||||
any.haskell-lexer ==1.1.1,
|
||||
any.haskoin-core ==1.0.4,
|
||||
any.haskoin-core ==1.1.0,
|
||||
any.hexstring ==0.12.1.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 ==2.11.9,
|
||||
any.hspec-core ==2.11.9,
|
||||
any.hspec-discover ==2.11.9,
|
||||
any.hspec-expectations ==0.8.4,
|
||||
any.http-client ==0.7.16,
|
||||
any.http-client ==0.7.17,
|
||||
http-client +network-uri,
|
||||
any.http-client-tls ==0.3.6.3,
|
||||
any.http-conduit ==2.3.8.3,
|
||||
any.http-conduit ==2.3.9,
|
||||
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.indexed-traversable ==0.1.4,
|
||||
any.indexed-traversable-instances ==0.1.2,
|
||||
any.integer-conversion ==0.1.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.iproute ==1.7.14,
|
||||
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.mono-traversable ==1.0.20.0,
|
||||
any.mtl ==2.3.1,
|
||||
any.murmur3 ==1.0.5,
|
||||
any.network ==3.1.4.0,
|
||||
any.network ==3.2.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.os-string ==2.0.6,
|
||||
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.process ==1.6.19.0,
|
||||
any.quickcheck-io ==0.2.0,
|
||||
any.quickcheck-transformer ==0.3.1.2,
|
||||
any.random ==1.2.1.2,
|
||||
any.regex-base ==0.94.0.2,
|
||||
any.regex-compat ==0.95.2.1,
|
||||
|
|
@ -147,12 +149,12 @@ constraints: any.Cabal ==3.8.1.0,
|
|||
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,
|
||||
any.scientific ==0.3.8.0,
|
||||
scientific -integer-simple,
|
||||
any.secp256k1-haskell ==1.4.0,
|
||||
any.semialign ==1.3.1,
|
||||
semialign +semigroupoids,
|
||||
any.semigroupoids ==6.0.0.1,
|
||||
any.semigroupoids ==6.0.1,
|
||||
semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
|
||||
any.serialise ==0.2.6.1,
|
||||
serialise +newtime15,
|
||||
|
|
@ -164,44 +166,43 @@ constraints: any.Cabal ==3.8.1.0,
|
|||
any.stm ==2.5.1.0,
|
||||
any.streaming-commons ==0.2.2.6,
|
||||
streaming-commons -use-bytestring-builder,
|
||||
any.strict ==0.5,
|
||||
any.strict ==0.5.1,
|
||||
any.string-conversions ==0.4.0.1,
|
||||
any.tagged ==0.8.8,
|
||||
tagged +deepseq +transformers,
|
||||
any.template-haskell ==2.19.0.0,
|
||||
any.template-haskell ==2.20.0.0,
|
||||
any.text ==2.0.2,
|
||||
any.text-iso8601 ==0.1,
|
||||
any.text-short ==0.1.5,
|
||||
any.text-iso8601 ==0.1.1,
|
||||
any.text-short ==0.1.6,
|
||||
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.th-abstraction ==0.7.0.0,
|
||||
any.th-compat ==0.1.5,
|
||||
any.these ==1.2.1,
|
||||
any.time ==1.12.2,
|
||||
any.time-compat ==1.9.6.1,
|
||||
time-compat -old-locale,
|
||||
any.tls ==2.0.1,
|
||||
any.time-compat ==1.9.7,
|
||||
any.tls ==2.1.0,
|
||||
tls -devel,
|
||||
any.transformers ==0.5.6.2,
|
||||
any.transformers ==0.6.1.0,
|
||||
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.typed-process ==0.2.12.0,
|
||||
any.unix ==2.8.4.0,
|
||||
any.unix-time ==0.4.15,
|
||||
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.uuid-types ==1.0.6,
|
||||
any.vector ==0.13.1.0,
|
||||
vector +boundschecks -internalchecks -unsafechecks -wall,
|
||||
any.vector-algorithms ==0.9.0.1,
|
||||
any.vector-algorithms ==0.9.0.2,
|
||||
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,
|
||||
any.witherable ==0.5,
|
||||
any.zlib ==0.7.1.0,
|
||||
zlib -bundled-c-zlib +non-blocking-ffi +pkg-config
|
||||
index-state: hackage.haskell.org 2024-03-06T20:26:39Z
|
||||
index-state: hackage.haskell.org 2024-10-11T12:55:31Z
|
||||
|
|
|
|||
6
configure
vendored
6
configure
vendored
|
|
@ -1,5 +1,5 @@
|
|||
#!/bin/bash
|
||||
|
||||
echo "export PKG_CONFIG_PATH=$HOME/.local/share/zcash-haskell:\$PKG_CONFIG_PATH" | tee -a ~/.bashrc
|
||||
echo "export LD_LIBRARY_PATH=$HOME/.local/share/zcash-haskell:\$LD_LIBRARY_PATH" | tee -a ~/.bashrc
|
||||
echo -e "\n"
|
||||
echo "export PKG_CONFIG_PATH=$(pwd)/librustzcash-wrapper/target/x86_64-unknown-linux-gnu/debug:\$PKG_CONFIG_PATH" | tee -a ~/.bashrc
|
||||
echo "export LD_LIBRARY_PATH=$(pwd)/librustzcash-wrapper/target/x86_64-unknown-linux-gnu/debug:\$LD_LIBRARY_PATH" | tee -a ~/.bashrc
|
||||
source ~/.bashrc
|
||||
|
|
|
|||
1123
librustzcash-wrapper/Cargo.lock
generated
1123
librustzcash-wrapper/Cargo.lock
generated
File diff suppressed because it is too large
Load diff
|
|
@ -9,20 +9,23 @@ haskell-ffi.git = "https://github.com/BeFunctional/haskell-rust-ffi.git"
|
|||
haskell-ffi.rev = "2bf292e2e56eac8e9fb0fb2e1450cf4a4bd01274"
|
||||
f4jumble = "0.1"
|
||||
zcash_address = "0.2.0"
|
||||
borsh = "0.10"
|
||||
borsh = "0.9"
|
||||
bech32 = "0.11"
|
||||
orchard = "0.7.1"
|
||||
orchard = "0.10.0"
|
||||
zcash_note_encryption = "0.4.0"
|
||||
zcash_primitives = { version = "0.14.0", features = ["transparent-inputs"]}
|
||||
zcash_client_backend = "0.11.1"
|
||||
sapling-crypto = "0.1.3"
|
||||
zip32 = "0.1.0"
|
||||
zcash_primitives = { version = "0.21.0", features = ["transparent-inputs"]}
|
||||
zcash_client_backend = "0.16.0"
|
||||
sapling-crypto = "0.4"
|
||||
zip32 = "0.1.2"
|
||||
proc-macro2 = "1.0.66"
|
||||
nonempty = "0.7.0"
|
||||
incrementalmerkletree = "0.5.0"
|
||||
secp256k1 = "0.26.0"
|
||||
incrementalmerkletree = "0.7.0"
|
||||
secp256k1 = "0.27.0"
|
||||
jubjub = "0.10.0"
|
||||
rand_core = { version = "0.6.4", features = ["getrandom"]}
|
||||
wagyu-zcash-parameters = "0.2.0"
|
||||
bip0039 = "0.12.0"
|
||||
ahash = "0.7.8"
|
||||
|
||||
|
||||
[features]
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
[toolchain]
|
||||
channel = "nightly-2024-02-04"
|
||||
channel = "nightly"
|
||||
components = [ "rustfmt", "rustc-dev"]
|
||||
profile = "minimal"
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load diff
167
src/C/Zcash.chs
167
src/C/Zcash.chs
|
|
@ -120,6 +120,13 @@ import ZcashHaskell.Types
|
|||
-> `()'
|
||||
#}
|
||||
|
||||
{# fun unsafe rust_wrapper_uivk_decode as rustWrapperUivkDecode
|
||||
{ toBorshVar* `BS.ByteString'&
|
||||
, getVarBuffer `Buffer UnifiedIncomingViewingKey'&
|
||||
}
|
||||
-> `()'
|
||||
#}
|
||||
|
||||
{# fun unsafe rust_wrapper_orchard_note_decrypt as rustWrapperOrchardNoteDecode
|
||||
{ toBorshVar* `BS.ByteString'&
|
||||
, toBorshVar* `OrchardAction'&
|
||||
|
|
@ -204,15 +211,15 @@ import ZcashHaskell.Types
|
|||
#}
|
||||
|
||||
{# fun unsafe rust_wrapper_read_sapling_commitment_tree as rustWrapperReadSaplingCommitmentTree
|
||||
{ toBorshVar* `BS.ByteString'&
|
||||
{ toBorshVar* `SaplingFrontier'&
|
||||
, toBorshVar* `BS.ByteString'&
|
||||
, getVarBuffer `Buffer HexString'&
|
||||
, getVarBuffer `Buffer SaplingFrontier'&
|
||||
}
|
||||
-> `()'
|
||||
#}
|
||||
|
||||
{# fun unsafe rust_wrapper_read_sapling_witness as rustWrapperReadSaplingWitness
|
||||
{ toBorshVar* `BS.ByteString'&
|
||||
{ toBorshVar* `SaplingFrontier'&
|
||||
, getVarBuffer `Buffer HexString'&
|
||||
}
|
||||
-> `()'
|
||||
|
|
@ -232,6 +239,13 @@ import ZcashHaskell.Types
|
|||
-> `()'
|
||||
#}
|
||||
|
||||
{# fun unsafe rust_wrapper_read_sapling_frontier as rustWrapperReadSaplingFrontier
|
||||
{ toBorshVar* `BS.ByteString'&
|
||||
, getVarBuffer `Buffer SaplingFrontier'&
|
||||
}
|
||||
-> `()'
|
||||
#}
|
||||
|
||||
{# fun unsafe rust_wrapper_decode_sapling_address as rustWrapperDecodeSaplingAddress
|
||||
{ toBorshVar* `BS.ByteString'&
|
||||
, getVarBuffer `Buffer (BS.ByteString)'&
|
||||
|
|
@ -239,16 +253,120 @@ import ZcashHaskell.Types
|
|||
-> `()'
|
||||
#}
|
||||
|
||||
{# fun unsafe rust_wrapper_read_orchard_commitment_tree as rustWrapperReadOrchardCommitmentTree
|
||||
{# fun unsafe rust_wrapper_read_sapling_node as rustWrapperReadSaplingNode
|
||||
{ toBorshVar* `BS.ByteString'&
|
||||
, getVarBuffer `Buffer HexString'&
|
||||
}
|
||||
-> `()'
|
||||
#}
|
||||
|
||||
{# fun unsafe rust_wrapper_combine_sapling_nodes as rustWrapperCombineSaplingNodes
|
||||
{ `Int8'
|
||||
, toBorshVar* `BS.ByteString'&
|
||||
, toBorshVar* `BS.ByteString'&
|
||||
, getVarBuffer `Buffer HexString'&
|
||||
}
|
||||
-> `()'
|
||||
#}
|
||||
|
||||
{# fun unsafe rust_wrapper_read_orchard_witness as rustWrapperReadOrchardWitness
|
||||
{# fun unsafe rust_wrapper_get_sapling_root as rustWrapperGetSaplingRootTest
|
||||
{ `Int8'
|
||||
, getVarBuffer `Buffer HexString'&
|
||||
}
|
||||
-> `()'
|
||||
#}
|
||||
|
||||
{# fun unsafe rust_wrapper_read_sapling_commitment_tree_parts as rustWrapperReadSaplingTreeParts
|
||||
{ toBorshVar* `BS.ByteString'&
|
||||
, getVarBuffer `Buffer SaplingRawTree'&
|
||||
}
|
||||
-> `()'
|
||||
#}
|
||||
|
||||
{# fun unsafe rust_wrapper_read_sapling_tree_anchor as rustWrapperReadSaplingTreeAnchor
|
||||
{ toBorshVar* `BS.ByteString'&
|
||||
, getVarBuffer `Buffer HexString'&
|
||||
}
|
||||
-> `()'
|
||||
#}
|
||||
|
||||
{# fun unsafe rust_wrapper_read_sapling_path_anchor as rustWrapperReadSaplingPathAnchor
|
||||
{ toBorshVar* `MerklePath'&
|
||||
, toBorshVar* `BS.ByteString'&
|
||||
, getVarBuffer `Buffer HexString'&
|
||||
}
|
||||
-> `()'
|
||||
#}
|
||||
|
||||
{# fun unsafe rust_wrapper_read_orchard_node as rustWrapperReadOrchardNode
|
||||
{ toBorshVar* `BS.ByteString'&
|
||||
, getVarBuffer `Buffer HexString'&
|
||||
}
|
||||
-> `()'
|
||||
#}
|
||||
|
||||
{# fun unsafe rust_wrapper_combine_orchard_nodes as rustWrapperCombineOrchardNodes
|
||||
{ `Int8'
|
||||
, toBorshVar* `BS.ByteString'&
|
||||
, toBorshVar* `BS.ByteString'&
|
||||
, getVarBuffer `Buffer HexString'&
|
||||
}
|
||||
-> `()'
|
||||
#}
|
||||
|
||||
{# fun unsafe rust_wrapper_read_orchard_tree_anchor as rustWrapperReadOrchardTreeAnchor
|
||||
{ toBorshVar* `BS.ByteString'&
|
||||
, getVarBuffer `Buffer HexString'&
|
||||
}
|
||||
-> `()'
|
||||
#}
|
||||
|
||||
{# fun unsafe rust_wrapper_read_orchard_witness_anchor as rustWrapperReadOrchardWitnessAnchor
|
||||
{ toBorshVar* `BS.ByteString'&
|
||||
, getVarBuffer `Buffer HexString'&
|
||||
}
|
||||
-> `()'
|
||||
#}
|
||||
|
||||
{# fun unsafe rust_wrapper_read_orchard_path_anchor as rustWrapperReadOrchardPathAnchor
|
||||
{ toBorshVar* `MerklePath'&
|
||||
, toBorshVar* `BS.ByteString'&
|
||||
, getVarBuffer `Buffer HexString'&
|
||||
}
|
||||
-> `()'
|
||||
#}
|
||||
|
||||
{# fun unsafe rust_wrapper_get_orchard_root as rustWrapperGetOrchardRootTest
|
||||
{ `Int8'
|
||||
, getVarBuffer `Buffer HexString'&
|
||||
}
|
||||
-> `()'
|
||||
#}
|
||||
|
||||
{# fun unsafe rust_wrapper_read_orchard_commitment_tree as rustWrapperReadOrchardCommitmentTree
|
||||
{ toBorshVar* `OrchardFrontier'&
|
||||
, toBorshVar* `BS.ByteString'&
|
||||
, getVarBuffer `Buffer OrchardFrontier'&
|
||||
}
|
||||
-> `()'
|
||||
#}
|
||||
|
||||
{# fun unsafe rust_wrapper_read_orchard_commitment_tree_parts as rustWrapperReadOrchardTreeParts
|
||||
{ toBorshVar* `BS.ByteString'&
|
||||
, getVarBuffer `Buffer OrchardRawTree'&
|
||||
}
|
||||
-> `()'
|
||||
#}
|
||||
|
||||
{# fun unsafe rust_wrapper_read_orchard_frontier as rustWrapperReadOrchardFrontier
|
||||
{ toBorshVar* `BS.ByteString'&
|
||||
, getVarBuffer `Buffer OrchardFrontier'&
|
||||
}
|
||||
-> `()'
|
||||
#}
|
||||
|
||||
{# fun unsafe rust_wrapper_read_orchard_witness as rustWrapperReadOrchardWitness
|
||||
{ toBorshVar* `OrchardFrontier'&
|
||||
, getVarBuffer `Buffer HexString'&
|
||||
}
|
||||
-> `()'
|
||||
|
|
@ -260,6 +378,15 @@ import ZcashHaskell.Types
|
|||
-> `Word64'
|
||||
#}
|
||||
|
||||
{# fun unsafe rust_wrapper_orchard_add_node as rustWrapperOrchardAddNodeTest
|
||||
{ `Int8'
|
||||
, toBorshVar* `BS.ByteString'&
|
||||
, getVarBuffer `Buffer HexString'&
|
||||
}
|
||||
-> `()'
|
||||
|
||||
#}
|
||||
|
||||
{# fun unsafe rust_wrapper_update_sapling_witness as rustWrapperUpdateSaplingWitness
|
||||
{ toBorshVar* `BS.ByteString'&
|
||||
, toBorshVar* `[BS.ByteString]'&
|
||||
|
|
@ -283,8 +410,6 @@ import ZcashHaskell.Types
|
|||
, toBorshVar* `[SaplingTxSpend]'&
|
||||
, toBorshVar* `[OrchardTxSpend]'&
|
||||
, toBorshVar* `[OutgoingNote]'&
|
||||
, toBorshVar* `BS.ByteString'&
|
||||
, toBorshVar* `BS.ByteString'&
|
||||
, `Bool'
|
||||
, `Word64'
|
||||
, `Bool'
|
||||
|
|
@ -292,3 +417,31 @@ import ZcashHaskell.Types
|
|||
}
|
||||
-> `()'
|
||||
#}
|
||||
|
||||
{# fun unsafe rust_wrapper_create_orchard_fvk as rustWrapperCreateOrchardFvk
|
||||
{ toBorshVar* `BS.ByteString'&
|
||||
, getVarBuffer `Buffer HexString'&
|
||||
}
|
||||
-> `()'
|
||||
#}
|
||||
|
||||
{# fun unsafe rust_wrapper_create_orchard_ivk as rustWrapperCreateOrchardIvk
|
||||
{ toBorshVar* `BS.ByteString'&
|
||||
, getVarBuffer `Buffer HexString'&
|
||||
}
|
||||
-> `()'
|
||||
#}
|
||||
|
||||
{# fun unsafe rust_wrapper_create_sapling_fvk as rustWrapperCreateSaplingFvk
|
||||
{ toBorshVar* `BS.ByteString'&
|
||||
, getVarBuffer `Buffer HexString'&
|
||||
}
|
||||
-> `()'
|
||||
#}
|
||||
|
||||
{# fun unsafe rust_wrapper_create_sapling_ivk as rustWrapperCreateSaplingIvk
|
||||
{ toBorshVar* `BS.ByteString'&
|
||||
, getVarBuffer `Buffer HexString'&
|
||||
}
|
||||
-> `()'
|
||||
#}
|
||||
|
|
|
|||
|
|
@ -15,13 +15,42 @@
|
|||
module ZcashHaskell.Keys where
|
||||
|
||||
import C.Zcash (rustWrapperGenSeedPhrase, rustWrapperGetSeed)
|
||||
import Crypto.Secp256k1 (createContext)
|
||||
import qualified Data.ByteString as BS
|
||||
import Data.HexString (hexBytes)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
import Data.Word (Word8(..))
|
||||
import Foreign.Rust.Marshall.Variable
|
||||
( withBorshVarBuffer
|
||||
, withPureBorshVarBuffer
|
||||
)
|
||||
import ZcashHaskell.Types (Phrase, Seed(..), ToBytes(..))
|
||||
import Haskoin.Address.Base58 (decodeBase58)
|
||||
import Haskoin.Crypto.Keys.Extended
|
||||
( DerivPath(..)
|
||||
, DerivPathI(..)
|
||||
, XPubKey(..)
|
||||
, derivePath
|
||||
, deriveXPubKey
|
||||
, xPubExport
|
||||
)
|
||||
import Haskoin.Network.Constants (btc)
|
||||
import ZcashHaskell.Orchard (deriveOrchardFvk, deriveOrchardIvk)
|
||||
import ZcashHaskell.Sapling (deriveSaplingFvk, deriveSaplingIvk)
|
||||
import ZcashHaskell.Types
|
||||
( OrchardSpendingKey(..)
|
||||
, Phrase
|
||||
, SaplingSpendingKey(..)
|
||||
, Seed(..)
|
||||
, ToBytes(..)
|
||||
, TransparentSpendingKey(..)
|
||||
, ZcashNet(..)
|
||||
, uniFullViewingKeyHrp
|
||||
, uniIncomingViewingKeyHrp
|
||||
, uniTestFullViewingKeyHrp
|
||||
, uniTestIncomingViewingKeyHrp
|
||||
)
|
||||
import ZcashHaskell.Utils (encodeBech32m, f4Jumble)
|
||||
|
||||
-- | Generate a random seed that can be used to generate private keys for shielded addresses and transparent addresses.
|
||||
generateWalletSeedPhrase :: IO Phrase
|
||||
|
|
@ -36,3 +65,97 @@ getWalletSeed p =
|
|||
where
|
||||
result :: Seed
|
||||
result = (withPureBorshVarBuffer . rustWrapperGetSeed) p
|
||||
|
||||
-- | Derive a transparent root node for unified viewing keys
|
||||
deriveFullTransparentNode :: TransparentSpendingKey -> IO BS.ByteString
|
||||
deriveFullTransparentNode sk = do
|
||||
ioCtx <- createContext
|
||||
let tPubKey = deriveXPubKey ioCtx sk
|
||||
let tPubKeyBytes = decodeBase58 $ xPubExport btc ioCtx tPubKey
|
||||
case tPubKeyBytes of
|
||||
Nothing -> fail "Unable to get transparent key bytes"
|
||||
Just pb -> return $ BS.takeEnd 65 pb
|
||||
|
||||
-- | Derive a transparent incoming root node for unified incoming viewing keys
|
||||
deriveIncomingTransparentNode :: TransparentSpendingKey -> IO BS.ByteString
|
||||
deriveIncomingTransparentNode sk = do
|
||||
ioCtx <- createContext
|
||||
let path = Deriv :/ 0 :: DerivPath
|
||||
let childPrvKey = derivePath ioCtx path sk
|
||||
let tPubKey = deriveXPubKey ioCtx childPrvKey
|
||||
let tPubKeyBytes = decodeBase58 $ xPubExport btc ioCtx tPubKey
|
||||
case tPubKeyBytes of
|
||||
Nothing -> fail "Unable to get transparent key bytes"
|
||||
Just pb -> return $ BS.takeEnd 65 pb
|
||||
|
||||
-- | Derive a Unified Full Viewing Key
|
||||
deriveUfvk ::
|
||||
ZcashNet
|
||||
-> OrchardSpendingKey
|
||||
-> SaplingSpendingKey
|
||||
-> TransparentSpendingKey
|
||||
-> IO T.Text
|
||||
deriveUfvk net okey skey tkey = do
|
||||
tSec <- deriveFullTransparentNode tkey
|
||||
let oSec = deriveOrchardFvk okey
|
||||
let sSec = deriveSaplingFvk skey
|
||||
case oSec of
|
||||
Nothing -> fail "Unable to derive Orchard viewing key"
|
||||
Just oSec' -> do
|
||||
case sSec of
|
||||
Nothing -> fail "Unable to derive Sapling viewing key"
|
||||
Just sSec' ->
|
||||
return $ encodeVK (hexBytes oSec') (hexBytes sSec') tSec net True
|
||||
|
||||
-- | Derive a Unified Incoming Viewing Key
|
||||
deriveUivk ::
|
||||
ZcashNet
|
||||
-> OrchardSpendingKey
|
||||
-> SaplingSpendingKey
|
||||
-> TransparentSpendingKey
|
||||
-> IO T.Text
|
||||
deriveUivk net okey skey tkey = do
|
||||
tSec <- deriveIncomingTransparentNode tkey
|
||||
let oSec = deriveOrchardIvk okey
|
||||
let sSec = deriveSaplingIvk skey
|
||||
case oSec of
|
||||
Nothing -> fail "Unable to derive Orchard viewing key"
|
||||
Just oSec' -> do
|
||||
case sSec of
|
||||
Nothing -> fail "Unable to derive Sapling viewing key"
|
||||
Just sSec' ->
|
||||
return $ encodeVK (hexBytes oSec') (hexBytes sSec') tSec net False
|
||||
|
||||
-- | Encode a Unified Viewing Key per [ZIP-316](https://zips.z.cash/zip-0316)
|
||||
encodeVK ::
|
||||
BS.ByteString -- ^ Orchard FVK
|
||||
-> BS.ByteString -- ^ Sapling FVK
|
||||
-> BS.ByteString -- ^ Transparent root node
|
||||
-> ZcashNet -- ^ Network
|
||||
-> Bool -- ^ Full?
|
||||
-> T.Text
|
||||
encodeVK ovk svk tvk net full = encodeBech32m (E.encodeUtf8 hr) b
|
||||
where
|
||||
tReceiver = packReceiver 0x00 $ Just tvk
|
||||
b = f4Jumble $ tReceiver <> sReceiver <> oReceiver <> padding
|
||||
hr =
|
||||
if full
|
||||
then case net of
|
||||
MainNet -> uniFullViewingKeyHrp
|
||||
TestNet -> uniTestFullViewingKeyHrp
|
||||
else case net of
|
||||
MainNet -> uniIncomingViewingKeyHrp
|
||||
TestNet -> uniTestIncomingViewingKeyHrp
|
||||
sReceiver = packReceiver 0x02 $ Just svk
|
||||
oReceiver = packReceiver 0x03 $ Just ovk
|
||||
padding = E.encodeUtf8 $ T.justifyLeft 16 '\NUL' hr
|
||||
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
|
||||
|
|
|
|||
|
|
@ -18,16 +18,28 @@
|
|||
module ZcashHaskell.Orchard where
|
||||
|
||||
import C.Zcash
|
||||
( rustWrapperGenOrchardReceiver
|
||||
( rustWrapperCombineOrchardNodes
|
||||
, rustWrapperCreateOrchardFvk
|
||||
, rustWrapperCreateOrchardIvk
|
||||
, rustWrapperGenOrchardReceiver
|
||||
, rustWrapperGenOrchardSpendKey
|
||||
, rustWrapperGetOrchardRootTest
|
||||
, rustWrapperOrchardAddNodeTest
|
||||
, rustWrapperOrchardCheck
|
||||
, rustWrapperOrchardNoteDecode
|
||||
, rustWrapperOrchardNoteDecodeSK
|
||||
, rustWrapperReadOrchardCommitmentTree
|
||||
, rustWrapperReadOrchardFrontier
|
||||
, rustWrapperReadOrchardNode
|
||||
, rustWrapperReadOrchardPathAnchor
|
||||
, rustWrapperReadOrchardPosition
|
||||
, rustWrapperReadOrchardTreeAnchor
|
||||
, rustWrapperReadOrchardTreeParts
|
||||
, rustWrapperReadOrchardWitness
|
||||
, rustWrapperReadOrchardWitnessAnchor
|
||||
, rustWrapperUADecode
|
||||
, rustWrapperUfvkDecode
|
||||
, rustWrapperUivkDecode
|
||||
, rustWrapperUpdateOrchardWitness
|
||||
)
|
||||
import qualified Data.ByteString as BS
|
||||
|
|
@ -37,6 +49,11 @@ import qualified Data.Text as T
|
|||
import qualified Data.Text.Encoding as E
|
||||
import Data.Word
|
||||
import Foreign.Rust.Marshall.Variable
|
||||
import ZcashHaskell.Sapling (decodeSaplingAddress)
|
||||
import ZcashHaskell.Transparent
|
||||
( decodeExchangeAddress
|
||||
, decodeTransparentAddress
|
||||
)
|
||||
import ZcashHaskell.Types
|
||||
import ZcashHaskell.Utils (encodeBech32, encodeBech32m, f4Jumble)
|
||||
|
||||
|
|
@ -98,9 +115,9 @@ isValidUnifiedAddress str =
|
|||
(if BS.length (raw_s x) == 43
|
||||
then Just $ SaplingReceiver (raw_s x)
|
||||
else Nothing)
|
||||
(if not (BS.null (raw_t x))
|
||||
(if BS.length (raw_t x) > 1
|
||||
then Just $ TransparentReceiver P2PKH (fromRawBytes $ raw_t x)
|
||||
else if not (BS.null (raw_to x))
|
||||
else if BS.length (raw_to x) > 1
|
||||
then Just $ TransparentReceiver P2SH (fromRawBytes $ raw_to x)
|
||||
else Nothing)
|
||||
|
||||
|
|
@ -143,6 +160,15 @@ decodeUfvk str =
|
|||
where
|
||||
decodedKey = (withPureBorshVarBuffer . rustWrapperUfvkDecode) str
|
||||
|
||||
-- | Attempts to decode the given bytestring into a Unified Full Viewing Key
|
||||
decodeUivk :: BS.ByteString -> Maybe UnifiedIncomingViewingKey
|
||||
decodeUivk str =
|
||||
case i_net decodedKey of
|
||||
0 -> Nothing
|
||||
_ -> Just decodedKey
|
||||
where
|
||||
decodedKey = (withPureBorshVarBuffer . rustWrapperUivkDecode) str
|
||||
|
||||
-- | Check if the given UVK matches the UA given
|
||||
matchOrchardAddress :: BS.ByteString -> BS.ByteString -> Bool
|
||||
matchOrchardAddress = rustWrapperOrchardCheck
|
||||
|
|
@ -189,40 +215,159 @@ decryptOrchardActionSK sk scope oa =
|
|||
withPureBorshVarBuffer $
|
||||
rustWrapperOrchardNoteDecodeSK (getBytes sk) oa (scope == External)
|
||||
|
||||
-- | Update a Orchard commitment tree
|
||||
updateOrchardCommitmentTree ::
|
||||
OrchardCommitmentTree -- ^ the base tree
|
||||
-> HexString -- ^ the new note commitment
|
||||
-> Maybe OrchardCommitmentTree
|
||||
updateOrchardCommitmentTree tree cmx =
|
||||
if BS.length (hexBytes updatedTree) > 1
|
||||
then Just $ OrchardCommitmentTree updatedTree
|
||||
getOrchardFrontier :: OrchardCommitmentTree -> Maybe OrchardFrontier
|
||||
getOrchardFrontier tree =
|
||||
if of_pos updatedTree > 1
|
||||
then Just updatedTree
|
||||
else Nothing
|
||||
where
|
||||
updatedTree =
|
||||
withPureBorshVarBuffer $
|
||||
rustWrapperReadOrchardCommitmentTree
|
||||
(hexBytes $ orchTree tree)
|
||||
(hexBytes cmx)
|
||||
rustWrapperReadOrchardFrontier $ toBytes $ orchTree tree
|
||||
|
||||
getOrchardTreeAnchor :: OrchardCommitmentTree -> HexString
|
||||
getOrchardTreeAnchor tree =
|
||||
withPureBorshVarBuffer $
|
||||
rustWrapperReadOrchardTreeAnchor $ toBytes $ orchTree tree
|
||||
|
||||
getOrchardWitnessAnchor :: OrchardWitness -> HexString
|
||||
getOrchardWitnessAnchor wit =
|
||||
withPureBorshVarBuffer $
|
||||
rustWrapperReadOrchardWitnessAnchor $ toBytes $ orchWit wit
|
||||
|
||||
getOrchardRootTest :: Int -> HexString
|
||||
getOrchardRootTest level =
|
||||
withPureBorshVarBuffer $ rustWrapperGetOrchardRootTest $ fromIntegral level
|
||||
|
||||
addOrchardNodeGetRoot :: Int -> BS.ByteString -> HexString
|
||||
addOrchardNodeGetRoot l n =
|
||||
withPureBorshVarBuffer $ rustWrapperOrchardAddNodeTest (fromIntegral l) n
|
||||
|
||||
getOrchardTreeParts :: OrchardCommitmentTree -> Maybe OrchardTree
|
||||
getOrchardTreeParts h =
|
||||
if isBlank (ort_left tree) && isBlank (ort_right tree)
|
||||
then Nothing
|
||||
else Just $
|
||||
OrchardTree
|
||||
(parseHex $ ort_left tree)
|
||||
(parseHex $ ort_right tree)
|
||||
(map parseHex (ort_parents tree))
|
||||
where
|
||||
isBlank h = (BS.length $ hexBytes $ h) == 1
|
||||
parseHex h =
|
||||
if (BS.length $ hexBytes $ h) > 1
|
||||
then Just h
|
||||
else Nothing
|
||||
tree =
|
||||
withPureBorshVarBuffer $
|
||||
rustWrapperReadOrchardTreeParts $ toBytes $ orchTree h
|
||||
|
||||
getOrchardPathAnchor :: HexString -> MerklePath -> HexString
|
||||
getOrchardPathAnchor hex p =
|
||||
withPureBorshVarBuffer $ rustWrapperReadOrchardPathAnchor p (hexBytes hex)
|
||||
|
||||
-- | Update a Orchard commitment tree
|
||||
updateOrchardCommitmentTree ::
|
||||
OrchardFrontier -- ^ the base tree
|
||||
-> HexString -- ^ the new note commitment
|
||||
-> Maybe OrchardFrontier
|
||||
updateOrchardCommitmentTree tree cmx =
|
||||
if of_pos updatedTree > 1
|
||||
then Just updatedTree
|
||||
else Nothing
|
||||
where
|
||||
updatedTree =
|
||||
withPureBorshVarBuffer $
|
||||
rustWrapperReadOrchardCommitmentTree tree (hexBytes cmx)
|
||||
|
||||
-- | Get the Orchard incremental witness from a commitment tree
|
||||
getOrchardWitness :: OrchardCommitmentTree -> Maybe OrchardWitness
|
||||
getOrchardWitness :: OrchardFrontier -> Maybe OrchardWitness
|
||||
getOrchardWitness tree =
|
||||
if BS.length (hexBytes wit) > 1
|
||||
then Just $ OrchardWitness wit
|
||||
else Nothing
|
||||
where
|
||||
wit =
|
||||
withPureBorshVarBuffer $
|
||||
rustWrapperReadOrchardWitness (hexBytes $ orchTree tree)
|
||||
wit = withPureBorshVarBuffer $ rustWrapperReadOrchardWitness tree
|
||||
|
||||
-- | Get the Sapling note position from a witness
|
||||
getOrchardNotePosition :: OrchardWitness -> Integer
|
||||
getOrchardNotePosition =
|
||||
fromIntegral . rustWrapperReadOrchardPosition . hexBytes . orchWit
|
||||
|
||||
-- | Update the witness of an Orchard note
|
||||
updateOrchardWitness :: OrchardWitness -> [HexString] -> OrchardWitness
|
||||
updateOrchardWitness wit cmus =
|
||||
OrchardWitness $
|
||||
withPureBorshVarBuffer $
|
||||
rustWrapperUpdateOrchardWitness (toBytes $ orchWit wit) (map toBytes cmus)
|
||||
if not (null cmus)
|
||||
then OrchardWitness $
|
||||
withPureBorshVarBuffer $
|
||||
rustWrapperUpdateOrchardWitness
|
||||
(toBytes $ orchWit wit)
|
||||
(map toBytes cmus)
|
||||
else wit
|
||||
|
||||
getOrchardNodeValue :: BS.ByteString -> Maybe HexString
|
||||
getOrchardNodeValue cmx =
|
||||
if BS.length (hexBytes n) > 1
|
||||
then Just n
|
||||
else Nothing
|
||||
where
|
||||
n = withPureBorshVarBuffer $ rustWrapperReadOrchardNode cmx
|
||||
|
||||
combineOrchardNodes :: Integer -> HexString -> HexString -> Maybe HexString
|
||||
combineOrchardNodes level n1 n2 =
|
||||
if BS.length (hexBytes r) > 1
|
||||
then Just r
|
||||
else Nothing
|
||||
where
|
||||
r =
|
||||
withPureBorshVarBuffer $
|
||||
rustWrapperCombineOrchardNodes
|
||||
(fromIntegral level)
|
||||
(toBytes n1)
|
||||
(toBytes n2)
|
||||
|
||||
-- | Parse a potential Zcash address
|
||||
parseAddress :: BS.ByteString -> Maybe ValidAddress
|
||||
parseAddress t =
|
||||
case isValidUnifiedAddress t of
|
||||
Nothing ->
|
||||
case decodeSaplingAddress t of
|
||||
Nothing ->
|
||||
case decodeTransparentAddress t of
|
||||
Nothing ->
|
||||
case decodeExchangeAddress t of
|
||||
Nothing -> Nothing
|
||||
Just x -> Just $ Exchange x
|
||||
Just t -> Just $ Transparent t
|
||||
Just s -> Just $ Sapling s
|
||||
Just u -> Just $ Unified u
|
||||
|
||||
compareAddress :: ValidAddress -> UnifiedAddress -> Bool
|
||||
compareAddress a u =
|
||||
case a of
|
||||
Unified i -> i == u
|
||||
Sapling s -> s_rec u == Just (sa_receiver s) && ua_net u == net_type s
|
||||
Transparent t -> t_rec u == Just (ta_receiver t) && ua_net u == ta_network t
|
||||
Exchange x -> False
|
||||
|
||||
-- | Derive an Orchard Full Viewing Key
|
||||
deriveOrchardFvk ::
|
||||
OrchardSpendingKey -- ^ The Orchard spending key
|
||||
-> Maybe HexString
|
||||
deriveOrchardFvk sk =
|
||||
if BS.length (hexBytes r) > 1
|
||||
then Just r
|
||||
else Nothing
|
||||
where
|
||||
r = withPureBorshVarBuffer $ rustWrapperCreateOrchardFvk $ getBytes sk
|
||||
|
||||
-- | Derive an Orchard Incoming Viewing Key
|
||||
deriveOrchardIvk ::
|
||||
OrchardSpendingKey -- ^ The Orchard spending key
|
||||
-> Maybe HexString
|
||||
deriveOrchardIvk sk =
|
||||
if BS.length (hexBytes r) > 1
|
||||
then Just r
|
||||
else Nothing
|
||||
where
|
||||
r = withPureBorshVarBuffer $ rustWrapperCreateOrchardIvk $ getBytes sk
|
||||
|
|
|
|||
|
|
@ -18,10 +18,19 @@
|
|||
module ZcashHaskell.Sapling where
|
||||
|
||||
import C.Zcash
|
||||
( rustWrapperDecodeSaplingAddress
|
||||
( rustWrapperCombineSaplingNodes
|
||||
, rustWrapperCreateSaplingFvk
|
||||
, rustWrapperCreateSaplingIvk
|
||||
, rustWrapperDecodeSaplingAddress
|
||||
, rustWrapperGetSaplingRootTest
|
||||
, rustWrapperIsShielded
|
||||
, rustWrapperReadSaplingCommitmentTree
|
||||
, rustWrapperReadSaplingFrontier
|
||||
, rustWrapperReadSaplingNode
|
||||
, rustWrapperReadSaplingPathAnchor
|
||||
, rustWrapperReadSaplingPosition
|
||||
, rustWrapperReadSaplingTreeAnchor
|
||||
, rustWrapperReadSaplingTreeParts
|
||||
, rustWrapperReadSaplingWitness
|
||||
, rustWrapperSaplingCheck
|
||||
, rustWrapperSaplingChgPaymentAddress
|
||||
|
|
@ -37,6 +46,7 @@ import Data.Aeson
|
|||
import qualified Data.ByteString as BS
|
||||
import qualified Data.ByteString.Char8 as C
|
||||
import Data.HexString (HexString(..), fromText, hexString, toBytes, toText)
|
||||
import Data.Int (Int8)
|
||||
import qualified Data.Text as T
|
||||
import Data.Word
|
||||
import Foreign.Rust.Marshall.Variable
|
||||
|
|
@ -95,12 +105,35 @@ instance FromJSON RawTxResponse where
|
|||
c <- obj .: "confirmations"
|
||||
b <- obj .: "blocktime"
|
||||
sSpend <- obj .: "vShieldedSpend"
|
||||
sOut <- obj .: "vShieldedOutput"
|
||||
case o of
|
||||
Nothing ->
|
||||
pure $ RawTxResponse i h sSpend (getShieldedOutputs h) [] ht c b
|
||||
pure $
|
||||
RawTxResponse
|
||||
i
|
||||
h
|
||||
sSpend
|
||||
(if not (null (sOut :: [Object]))
|
||||
then getShieldedOutputs h
|
||||
else [])
|
||||
[]
|
||||
ht
|
||||
c
|
||||
b
|
||||
Just o' -> do
|
||||
a <- o' .: "actions"
|
||||
pure $ RawTxResponse i h sSpend (getShieldedOutputs h) a ht c b
|
||||
pure $
|
||||
RawTxResponse
|
||||
i
|
||||
h
|
||||
sSpend
|
||||
(if not (null sOut)
|
||||
then getShieldedOutputs h
|
||||
else [])
|
||||
a
|
||||
ht
|
||||
c
|
||||
b
|
||||
|
||||
-- | Attempt to decode the given raw tx with the given Sapling spending key
|
||||
decodeSaplingOutputEsk ::
|
||||
|
|
@ -161,32 +194,88 @@ genSaplingInternalAddress sk =
|
|||
res =
|
||||
withPureBorshVarBuffer (rustWrapperSaplingChgPaymentAddress $ getBytes sk)
|
||||
|
||||
-- | Update a Sapling commitment tree
|
||||
updateSaplingCommitmentTree ::
|
||||
SaplingCommitmentTree -- ^ the base tree
|
||||
-> HexString -- ^ the new note commitment
|
||||
-> Maybe SaplingCommitmentTree
|
||||
updateSaplingCommitmentTree tree cmu =
|
||||
if BS.length (hexBytes updatedTree) > 1
|
||||
then Just $ SaplingCommitmentTree updatedTree
|
||||
getSaplingNodeValue :: BS.ByteString -> Maybe HexString
|
||||
getSaplingNodeValue cmu =
|
||||
if BS.length (hexBytes n) > 1
|
||||
then Just n
|
||||
else Nothing
|
||||
where
|
||||
n = withPureBorshVarBuffer $ rustWrapperReadSaplingNode cmu
|
||||
|
||||
combineSaplingNodes :: Int8 -> HexString -> HexString -> Maybe HexString
|
||||
combineSaplingNodes level n1 n2 =
|
||||
if BS.length (hexBytes r) > 1
|
||||
then Just r
|
||||
else Nothing
|
||||
where
|
||||
r =
|
||||
withPureBorshVarBuffer $
|
||||
rustWrapperCombineSaplingNodes level (toBytes n1) (toBytes n2)
|
||||
|
||||
getSaplingRootTest :: Int8 -> HexString
|
||||
getSaplingRootTest level =
|
||||
withPureBorshVarBuffer $ rustWrapperGetSaplingRootTest level
|
||||
|
||||
getSaplingTreeParts :: SaplingCommitmentTree -> Maybe SaplingTree
|
||||
getSaplingTreeParts h =
|
||||
if isBlank (srt_left tree) && isBlank (srt_right tree)
|
||||
then Nothing
|
||||
else Just $
|
||||
SaplingTree
|
||||
(parseHex $ srt_left tree)
|
||||
(parseHex $ srt_right tree)
|
||||
(map parseHex (srt_parents tree))
|
||||
where
|
||||
isBlank h = (BS.length $ hexBytes $ h) == 1
|
||||
parseHex h =
|
||||
if (BS.length $ hexBytes $ h) > 1
|
||||
then Just h
|
||||
else Nothing
|
||||
tree =
|
||||
withPureBorshVarBuffer $
|
||||
rustWrapperReadSaplingTreeParts $ toBytes $ sapTree h
|
||||
|
||||
getSaplingTreeAnchor :: SaplingCommitmentTree -> HexString
|
||||
getSaplingTreeAnchor tree =
|
||||
withPureBorshVarBuffer $
|
||||
rustWrapperReadSaplingTreeAnchor $ toBytes $ sapTree tree
|
||||
|
||||
getSaplingPathAnchor :: HexString -> MerklePath -> HexString
|
||||
getSaplingPathAnchor hex p =
|
||||
withPureBorshVarBuffer $ rustWrapperReadSaplingPathAnchor p (hexBytes hex)
|
||||
|
||||
getSaplingFrontier :: SaplingCommitmentTree -> Maybe SaplingFrontier
|
||||
getSaplingFrontier tree =
|
||||
if sf_pos updatedTree > 1
|
||||
then Just updatedTree
|
||||
else Nothing
|
||||
where
|
||||
updatedTree =
|
||||
withPureBorshVarBuffer $
|
||||
rustWrapperReadSaplingCommitmentTree
|
||||
(hexBytes $ sapTree tree)
|
||||
(hexBytes cmu)
|
||||
rustWrapperReadSaplingFrontier $ toBytes $ sapTree tree
|
||||
|
||||
-- | Update a Sapling commitment tree
|
||||
updateSaplingCommitmentTree ::
|
||||
SaplingFrontier -- ^ the base tree
|
||||
-> HexString -- ^ the new note commitment
|
||||
-> Maybe SaplingFrontier
|
||||
updateSaplingCommitmentTree tree cmu =
|
||||
if sf_pos updatedTree > 1
|
||||
then Just updatedTree
|
||||
else Nothing
|
||||
where
|
||||
updatedTree =
|
||||
withPureBorshVarBuffer $
|
||||
rustWrapperReadSaplingCommitmentTree tree (hexBytes cmu)
|
||||
|
||||
-- | Get the Sapling incremental witness from a commitment tree
|
||||
getSaplingWitness :: SaplingCommitmentTree -> Maybe SaplingWitness
|
||||
getSaplingWitness :: SaplingFrontier -> Maybe SaplingWitness
|
||||
getSaplingWitness tree =
|
||||
if BS.length (hexBytes wit) > 1
|
||||
then Just $ SaplingWitness wit
|
||||
else Nothing
|
||||
where
|
||||
wit =
|
||||
withPureBorshVarBuffer $
|
||||
rustWrapperReadSaplingWitness (hexBytes $ sapTree tree)
|
||||
wit = withPureBorshVarBuffer $ rustWrapperReadSaplingWitness tree
|
||||
|
||||
-- | Get the Sapling note position from a witness
|
||||
getSaplingNotePosition :: SaplingWitness -> Integer
|
||||
|
|
@ -195,9 +284,13 @@ getSaplingNotePosition =
|
|||
|
||||
updateSaplingWitness :: SaplingWitness -> [HexString] -> SaplingWitness
|
||||
updateSaplingWitness wit cmus =
|
||||
SaplingWitness $
|
||||
withPureBorshVarBuffer $
|
||||
rustWrapperUpdateSaplingWitness (toBytes $ sapWit wit) (map toBytes cmus)
|
||||
if not (null cmus)
|
||||
then SaplingWitness $
|
||||
withPureBorshVarBuffer $
|
||||
rustWrapperUpdateSaplingWitness
|
||||
(toBytes $ sapWit wit)
|
||||
(map toBytes cmus)
|
||||
else wit
|
||||
|
||||
-- | Encode a SaplingReceiver into HRF text
|
||||
encodeSaplingAddress :: ZcashNet -> SaplingReceiver -> Maybe T.Text
|
||||
|
|
@ -227,3 +320,25 @@ decodeSaplingAddress sapling_address = do
|
|||
where
|
||||
sa =
|
||||
withPureBorshVarBuffer $ rustWrapperDecodeSaplingAddress sapling_address
|
||||
|
||||
-- | Derive a Sapling Full Viewing Key
|
||||
deriveSaplingFvk ::
|
||||
SaplingSpendingKey -- ^ The Sapling spending key
|
||||
-> Maybe HexString
|
||||
deriveSaplingFvk sk =
|
||||
if BS.length (hexBytes r) > 1
|
||||
then Just r
|
||||
else Nothing
|
||||
where
|
||||
r = withPureBorshVarBuffer $ rustWrapperCreateSaplingFvk $ getBytes sk
|
||||
|
||||
-- | Derive a Sapling Incoming Viewing Key
|
||||
deriveSaplingIvk ::
|
||||
SaplingSpendingKey -- ^ The Sapling spending key
|
||||
-> Maybe HexString
|
||||
deriveSaplingIvk sk =
|
||||
if BS.length (hexBytes r) > 1
|
||||
then Just r
|
||||
else Nothing
|
||||
where
|
||||
r = withPureBorshVarBuffer $ rustWrapperCreateSaplingIvk $ getBytes sk
|
||||
|
|
|
|||
|
|
@ -1,3 +1,5 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
-- Copyright 2022-2024 Vergara Technologies LLC
|
||||
--
|
||||
-- This file is part of Zcash-Haskell.
|
||||
|
|
@ -172,27 +174,27 @@ decodeTransparentAddress taddress = do
|
|||
-- | Encode an Exchange Addresss into HRF from TransparentReceiver
|
||||
encodeExchangeAddress :: ZcashNet -> TransparentReceiver -> Maybe T.Text
|
||||
encodeExchangeAddress net tr = do
|
||||
case (tr_type tr) of
|
||||
case tr_type tr of
|
||||
P2PKH -> do
|
||||
case net of
|
||||
MainNet -> do
|
||||
let vhash = encodeBech32m (BC.pack "tex") (toBytes (tr_bytes tr))
|
||||
let vhash = encodeBech32m "tex" (toBytes (tr_bytes tr))
|
||||
Just vhash
|
||||
TestNet -> do
|
||||
let vhash = encodeBech32m (BC.pack "textest") (toBytes (tr_bytes tr))
|
||||
let vhash = encodeBech32m "textest" (toBytes (tr_bytes tr))
|
||||
Just vhash
|
||||
_ -> Nothing
|
||||
_any -> Nothing
|
||||
|
||||
-- | Decode an Exchange Address into a ExchangeAddress
|
||||
decodeExchangeAddress :: T.Text -> Maybe ExchangeAddress
|
||||
decodeExchangeAddress :: BS.ByteString -> Maybe ExchangeAddress
|
||||
decodeExchangeAddress ex = do
|
||||
if (T.length ex) > 1
|
||||
if BS.length ex > 1
|
||||
then do
|
||||
let rawd = decodeBech32 (E.encodeUtf8 ex)
|
||||
let tMain = BS.unpack (BC.pack "tex")
|
||||
let tTest = BS.unpack (BC.pack "textest")
|
||||
let tFail = BS.unpack (BC.pack "fail")
|
||||
let hr = BS.unpack (hrp rawd)
|
||||
let rawd = decodeBech32 ex
|
||||
let tMain = "tex"
|
||||
let tTest = "textest"
|
||||
let tFail = "fail"
|
||||
let hr = hrp rawd
|
||||
if hr /= tFail
|
||||
then do
|
||||
let transparentReceiver = bytes rawd
|
||||
|
|
|
|||
|
|
@ -38,6 +38,7 @@ import Data.Maybe (fromJust, fromMaybe)
|
|||
import Data.Structured
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
import qualified Data.Vector as V
|
||||
import Data.Word
|
||||
import qualified GHC.Generics as GHC
|
||||
import qualified Generics.SOP as SOP
|
||||
|
|
@ -90,7 +91,7 @@ data ZcashNet
|
|||
= MainNet
|
||||
| TestNet
|
||||
| RegTestNet
|
||||
deriving (Eq, Prelude.Show, Read)
|
||||
deriving (Eq, Prelude.Show, Read, GHC.Generic, ToJSON, FromJSON)
|
||||
|
||||
type AccountId = Int
|
||||
|
||||
|
|
@ -133,6 +134,18 @@ data Transaction = Transaction
|
|||
, tx_orchardBundle :: !(Maybe OrchardBundle)
|
||||
} deriving (Prelude.Show, Eq, Read)
|
||||
|
||||
instance ToJSON Transaction where
|
||||
toJSON (Transaction t h c e tb sb ob) =
|
||||
object
|
||||
[ "txid" .= t
|
||||
, "height" .= h
|
||||
, "confirmations" .= c
|
||||
, "expiry" .= e
|
||||
, "transparent" .= tb
|
||||
, "sapling" .= sb
|
||||
, "orchard" .= ob
|
||||
]
|
||||
|
||||
-- | The transparent portion of a Zcash transaction
|
||||
data TransparentBundle = TransparentBundle
|
||||
{ tb_vin :: ![H.TxIn]
|
||||
|
|
@ -140,6 +153,10 @@ data TransparentBundle = TransparentBundle
|
|||
, tb_coinbase :: !Bool
|
||||
} deriving (Eq, Prelude.Show, Read)
|
||||
|
||||
instance ToJSON TransparentBundle where
|
||||
toJSON (TransparentBundle vin vout c) =
|
||||
object ["vin" .= vin, "vout" .= vout, "coinbase" .= c]
|
||||
|
||||
-- | Read a raw transparent bundle into the Haskell type
|
||||
fromRawTBundle :: RawTBundle -> Maybe TransparentBundle
|
||||
fromRawTBundle rtb =
|
||||
|
|
@ -239,7 +256,8 @@ instance FromJSON RpcError where
|
|||
-- ** `zcashd`
|
||||
-- | Type to represent response from the `zcashd` RPC `getblock` method
|
||||
data BlockResponse = BlockResponse
|
||||
{ bl_confirmations :: !Integer -- ^ Block confirmations
|
||||
{ bl_hash :: !HexString
|
||||
, bl_confirmations :: !Integer -- ^ Block confirmations
|
||||
, bl_height :: !Integer -- ^ Block height
|
||||
, bl_time :: !Integer -- ^ Block time
|
||||
, bl_txs :: ![HexString] -- ^ List of transaction IDs in the block
|
||||
|
|
@ -250,9 +268,20 @@ instance FromJSON BlockResponse where
|
|||
withObject "BlockResponse" $ \obj -> do
|
||||
c <- obj .: "confirmations"
|
||||
h <- obj .: "height"
|
||||
t <- obj .:? "time"
|
||||
t <- obj .: "time"
|
||||
txs <- obj .: "tx"
|
||||
pure $ BlockResponse c h (fromMaybe 0 t) txs
|
||||
hash <- obj .: "hash"
|
||||
pure $ BlockResponse hash c h t txs
|
||||
|
||||
instance ToJSON BlockResponse where
|
||||
toJSON (BlockResponse h c ht t txs) =
|
||||
object
|
||||
[ "hash" .= h
|
||||
, "confirmations" .= c
|
||||
, "height" .= ht
|
||||
, "time" .= t
|
||||
, "tx" .= txs
|
||||
]
|
||||
|
||||
-- | Type to represent response from the `zcashd` RPC `getrawtransaction`
|
||||
data RawTxResponse = RawTxResponse
|
||||
|
|
@ -324,6 +353,10 @@ data SaplingBundle = SaplingBundle
|
|||
, sbSig :: !HexString
|
||||
} deriving stock (Eq, Prelude.Show, GHC.Generic, Read)
|
||||
|
||||
instance ToJSON SaplingBundle where
|
||||
toJSON (SaplingBundle s o v sig) =
|
||||
object ["spends" .= s, "outputs" .= o, "value" .= v, "sig" .= sig]
|
||||
|
||||
fromRawSBundle :: RawSBundle -> Maybe SaplingBundle
|
||||
fromRawSBundle b =
|
||||
if zsb_empty b
|
||||
|
|
@ -355,6 +388,17 @@ data OrchardBundle = OrchardBundle
|
|||
, obSig :: !HexString
|
||||
} deriving stock (Eq, Prelude.Show, GHC.Generic, Read)
|
||||
|
||||
instance ToJSON OrchardBundle where
|
||||
toJSON (OrchardBundle a f v an p s) =
|
||||
object
|
||||
[ "actions" .= a
|
||||
, "flags" .= f
|
||||
, "value" .= v
|
||||
, "anchor" .= an
|
||||
, "proof" .= p
|
||||
, "sig" .= s
|
||||
]
|
||||
|
||||
fromRawOBundle :: RawOBundle -> Maybe OrchardBundle
|
||||
fromRawOBundle b =
|
||||
if zob_empty b
|
||||
|
|
@ -377,6 +421,10 @@ data OrchardFlags = OrchardFlags
|
|||
deriving anyclass (Data.Structured.Show)
|
||||
deriving (BorshSize, ToBorsh, FromBorsh) via AsStruct OrchardFlags
|
||||
|
||||
instance ToJSON OrchardFlags where
|
||||
toJSON (OrchardFlags s o) =
|
||||
Data.Aeson.Array $ V.fromList [Data.Aeson.Bool s, Data.Aeson.Bool o]
|
||||
|
||||
-- | Type for the response from the `zebrad` RPC method `getinfo`
|
||||
data ZebraGetInfo = ZebraGetInfo
|
||||
{ zgi_build :: !T.Text
|
||||
|
|
@ -501,6 +549,17 @@ data ShieldedSpend = ShieldedSpend
|
|||
deriving anyclass (Data.Structured.Show)
|
||||
deriving (BorshSize, ToBorsh, FromBorsh) via AsStruct ShieldedSpend
|
||||
|
||||
instance ToJSON ShieldedSpend where
|
||||
toJSON (ShieldedSpend cv a n rk p au) =
|
||||
object
|
||||
[ "cv" .= cv
|
||||
, "anchor" .= a
|
||||
, "nullifier" .= n
|
||||
, "rk" .= rk
|
||||
, "proof" .= p
|
||||
, "spendAuthSig" .= au
|
||||
]
|
||||
|
||||
instance FromJSON ShieldedSpend where
|
||||
parseJSON =
|
||||
withObject "ShieldedSpend" $ \obj -> do
|
||||
|
|
@ -525,6 +584,17 @@ data ShieldedOutput = ShieldedOutput
|
|||
deriving anyclass (Data.Structured.Show)
|
||||
deriving (BorshSize, ToBorsh, FromBorsh) via AsStruct ShieldedOutput
|
||||
|
||||
instance ToJSON ShieldedOutput where
|
||||
toJSON (ShieldedOutput c cm e enc o p) =
|
||||
object
|
||||
[ "cv" .= c
|
||||
, "cmu" .= cm
|
||||
, "ephemeralKey" .= e
|
||||
, "encCiphertext" .= enc
|
||||
, "outCiphertext" .= o
|
||||
, "proof" .= p
|
||||
]
|
||||
|
||||
instance FromJSON ShieldedOutput where
|
||||
parseJSON =
|
||||
withObject "ShieldedOutput" $ \obj -> do
|
||||
|
|
@ -541,6 +611,30 @@ newtype SaplingCommitmentTree = SaplingCommitmentTree
|
|||
{ sapTree :: HexString
|
||||
} deriving (Eq, Prelude.Show, Read)
|
||||
|
||||
data SaplingRawTree = SaplingRawTree
|
||||
{ srt_left :: !HexString
|
||||
, srt_right :: !HexString
|
||||
, srt_parents :: ![HexString]
|
||||
} deriving stock (Eq, Prelude.Show, GHC.Generic)
|
||||
deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo)
|
||||
deriving anyclass (Data.Structured.Show)
|
||||
deriving (BorshSize, ToBorsh, FromBorsh) via AsStruct SaplingRawTree
|
||||
|
||||
data SaplingTree = SaplingTree
|
||||
{ st_left :: !(Maybe HexString)
|
||||
, st_right :: !(Maybe HexString)
|
||||
, st_parents :: ![Maybe HexString]
|
||||
} deriving (Eq, Prelude.Show, Read)
|
||||
|
||||
data SaplingFrontier = SaplingFrontier
|
||||
{ sf_pos :: !Int64
|
||||
, sf_leaf :: !HexString
|
||||
, sf_ommers :: ![HexString]
|
||||
} deriving stock (Eq, Prelude.Show, GHC.Generic)
|
||||
deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo)
|
||||
deriving anyclass (Data.Structured.Show)
|
||||
deriving (BorshSize, ToBorsh, FromBorsh) via AsStruct SaplingFrontier
|
||||
|
||||
-- | Type for a Sapling incremental witness
|
||||
newtype SaplingWitness = SaplingWitness
|
||||
{ sapWit :: HexString
|
||||
|
|
@ -583,6 +677,14 @@ data RawUA = RawUA
|
|||
deriving anyclass (Data.Structured.Show)
|
||||
deriving (BorshSize, ToBorsh, FromBorsh) via AsStruct RawUA
|
||||
|
||||
-- | A type to handle user-entered addresses
|
||||
data ValidAddress
|
||||
= Unified !UnifiedAddress
|
||||
| Sapling !SaplingAddress
|
||||
| Transparent !TransparentAddress
|
||||
| Exchange !ExchangeAddress
|
||||
deriving stock (Eq, Prelude.Show)
|
||||
|
||||
-- | Type to represent a Unified Full Viewing Key
|
||||
data UnifiedFullViewingKey = UnifiedFullViewingKey
|
||||
{ net :: !Word8 -- ^ Number representing the network the key belongs to. @1@ for @mainnet@, @2@ for @testnet@ and @3@ for @regtestnet@.
|
||||
|
|
@ -594,6 +696,18 @@ data UnifiedFullViewingKey = UnifiedFullViewingKey
|
|||
deriving anyclass (Data.Structured.Show)
|
||||
deriving (BorshSize, ToBorsh, FromBorsh) via AsStruct UnifiedFullViewingKey
|
||||
|
||||
-- | Type to represent a Unified Incoming Viewing Key
|
||||
data UnifiedIncomingViewingKey = UnifiedIncomingViewingKey
|
||||
{ i_net :: !Word8 -- ^ Number representing the network the key belongs to. @1@ for @mainnet@, @2@ for @testnet@ and @3@ for @regtestnet@.
|
||||
, i_o_key :: !BS.ByteString -- ^ Raw bytes of the Orchard Incoming Viewing Key as specified in [ZIP-316](https://zips.z.cash/zip-0316)
|
||||
, i_s_key :: !BS.ByteString -- ^ Raw bytes of the Sapling Incoming Viewing Key as specified in [ZIP-316](https://zips.z.cash/zip-0316)
|
||||
, i_t_key :: !BS.ByteString -- ^ Raw bytes of the P2PKH chain code and public key as specified in [ZIP-316](https://zips.z.cash/zip-0316)
|
||||
} deriving stock (Eq, Prelude.Show, GHC.Generic)
|
||||
deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo)
|
||||
deriving anyclass (Data.Structured.Show)
|
||||
deriving (BorshSize, ToBorsh, FromBorsh) via AsStruct
|
||||
UnifiedIncomingViewingKey
|
||||
|
||||
-- | Type to represent an Orchard Action as provided by the @getrawtransaction@ RPC method of @zcashd@, and defined in the [Zcash Protocol](https://zips.z.cash/protocol/protocol.pdf)
|
||||
data OrchardAction = OrchardAction
|
||||
{ nf :: !HexString -- ^ The nullifier of the input note
|
||||
|
|
@ -609,6 +723,19 @@ data OrchardAction = OrchardAction
|
|||
deriving anyclass (Data.Structured.Show)
|
||||
deriving (BorshSize, ToBorsh, FromBorsh) via AsStruct OrchardAction
|
||||
|
||||
instance ToJSON OrchardAction where
|
||||
toJSON (OrchardAction n r c e en o cv a) =
|
||||
object
|
||||
[ "nullifier" .= n
|
||||
, "rk" .= r
|
||||
, "cmx" .= c
|
||||
, "ephemeralKey" .= e
|
||||
, "encCiphertext" .= en
|
||||
, "outCiphertext" .= o
|
||||
, "cv" .= cv
|
||||
, "spendAuthSig" .= a
|
||||
]
|
||||
|
||||
instance FromJSON OrchardAction where
|
||||
parseJSON =
|
||||
withObject "OrchardAction" $ \obj -> do
|
||||
|
|
@ -622,11 +749,43 @@ instance FromJSON OrchardAction where
|
|||
a <- obj .: "spendAuthSig"
|
||||
pure $ OrchardAction n r c ephKey encText outText cval a
|
||||
|
||||
data MerklePath = MerklePath
|
||||
{ mp_position :: !Int32
|
||||
, mp_path :: ![HexString]
|
||||
} deriving stock (Eq, Prelude.Show, GHC.Generic)
|
||||
deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo)
|
||||
deriving anyclass (Data.Structured.Show)
|
||||
deriving (BorshSize, ToBorsh, FromBorsh) via AsStruct MerklePath
|
||||
|
||||
-- | Type for a Orchard note commitment tree
|
||||
newtype OrchardCommitmentTree = OrchardCommitmentTree
|
||||
{ orchTree :: HexString
|
||||
} deriving (Eq, Prelude.Show, Read)
|
||||
|
||||
data OrchardRawTree = OrchardRawTree
|
||||
{ ort_left :: !HexString
|
||||
, ort_right :: !HexString
|
||||
, ort_parents :: ![HexString]
|
||||
} deriving stock (Eq, Prelude.Show, GHC.Generic)
|
||||
deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo)
|
||||
deriving anyclass (Data.Structured.Show)
|
||||
deriving (BorshSize, ToBorsh, FromBorsh) via AsStruct OrchardRawTree
|
||||
|
||||
data OrchardTree = OrchardTree
|
||||
{ ot_left :: !(Maybe HexString)
|
||||
, ot_right :: !(Maybe HexString)
|
||||
, ot_parents :: ![Maybe HexString]
|
||||
} deriving (Eq, Prelude.Show, Read)
|
||||
|
||||
data OrchardFrontier = OrchardFrontier
|
||||
{ of_pos :: !Int64
|
||||
, of_leaf :: !HexString
|
||||
, of_ommers :: ![HexString]
|
||||
} deriving stock (Eq, Prelude.Show, GHC.Generic)
|
||||
deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo)
|
||||
deriving anyclass (Data.Structured.Show)
|
||||
deriving (BorshSize, ToBorsh, FromBorsh) via AsStruct OrchardFrontier
|
||||
|
||||
-- | Type for a Sapling incremental witness
|
||||
newtype OrchardWitness = OrchardWitness
|
||||
{ orchWit :: HexString
|
||||
|
|
@ -665,7 +824,7 @@ data TransparentTxSpend = TransparentTxSpend
|
|||
data SaplingTxSpend = SaplingTxSpend
|
||||
{ ss_sk :: !BS.ByteString
|
||||
, ss_note :: !DecodedNote
|
||||
, ss_iw :: !BS.ByteString
|
||||
, ss_iw :: !MerklePath
|
||||
} deriving stock (Eq, Prelude.Show, GHC.Generic)
|
||||
deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo)
|
||||
deriving anyclass (Data.Structured.Show)
|
||||
|
|
@ -674,7 +833,7 @@ data SaplingTxSpend = SaplingTxSpend
|
|||
data OrchardTxSpend = OrchardTxSpend
|
||||
{ ss_sk :: !BS.ByteString
|
||||
, ss_note :: !DecodedNote
|
||||
, ss_iw :: !BS.ByteString
|
||||
, ss_iw :: !MerklePath
|
||||
} deriving stock (Eq, Prelude.Show, GHC.Generic)
|
||||
deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo)
|
||||
deriving anyclass (Data.Structured.Show)
|
||||
|
|
@ -712,6 +871,7 @@ data TxError
|
|||
| OrchardRecipient
|
||||
| SaplingBuilderNotAvailable
|
||||
| OrchardBuilderNotAvailable
|
||||
| PrivacyPolicyError !T.Text
|
||||
| ZHError
|
||||
deriving (Eq, Prelude.Show, Read)
|
||||
|
||||
|
|
|
|||
|
|
@ -123,50 +123,41 @@ readZebraTransaction hex =
|
|||
rawTx = (withPureBorshVarBuffer . rustWrapperTxRead) $ hexBytes hex
|
||||
|
||||
createTransaction ::
|
||||
Maybe SaplingCommitmentTree -- ^ to obtain the Sapling anchor
|
||||
-> Maybe OrchardCommitmentTree -- ^ to obtain the Orchard anchor
|
||||
HexString -- ^ to obtain the Sapling anchor
|
||||
-> HexString -- ^ to obtain the Orchard anchor
|
||||
-> [TransparentTxSpend] -- ^ the list of transparent notes to spend
|
||||
-> [SaplingTxSpend] -- ^ the list of Sapling notes to spend
|
||||
-> [OrchardTxSpend] -- ^ the list of Orchard notes to spend
|
||||
-> [OutgoingNote] -- ^ the list of outgoing notes, including change notes
|
||||
-> SaplingSpendParams -- ^ the Sapling circuit spending parameters
|
||||
-> SaplingOutputParams -- ^ the Sapling circuit output parameters
|
||||
-> ZcashNet -- ^ the network to be used
|
||||
-> Int -- ^ target block height
|
||||
-> Bool -- ^ True to build, False to estimate fee
|
||||
-> Either TxError HexString
|
||||
createTransaction sapAnchor orchAnchor tSpend sSpend oSpend outgoing sParams oParams znet bh build =
|
||||
-> IO (Either TxError HexString)
|
||||
createTransaction sapAnchor orchAnchor tSpend sSpend oSpend outgoing znet bh build = do
|
||||
txResult <-
|
||||
withBorshBufferOfInitSize 51200 $
|
||||
rustWrapperCreateTx
|
||||
(hexBytes sapAnchor)
|
||||
(hexBytes orchAnchor)
|
||||
tSpend
|
||||
sSpend
|
||||
oSpend
|
||||
outgoing
|
||||
(znet == MainNet)
|
||||
(fromIntegral bh)
|
||||
build
|
||||
if BS.length (hexBytes txResult) > 1
|
||||
then Right txResult
|
||||
then pure $ Right txResult
|
||||
else case head (BS.unpack $ hexBytes txResult) of
|
||||
0 -> Left InsufficientFunds
|
||||
1 -> Left ChangeRequired
|
||||
2 -> Left Fee
|
||||
3 -> Left Balance
|
||||
4 -> Left TransparentBuild
|
||||
5 -> Left SaplingBuild
|
||||
6 -> Left OrchardBuild
|
||||
7 -> Left OrchardSpend
|
||||
8 -> Left OrchardRecipient
|
||||
9 -> Left SaplingBuilderNotAvailable
|
||||
10 -> Left OrchardBuilderNotAvailable
|
||||
_ -> Left ZHError
|
||||
where
|
||||
txResult =
|
||||
withPureBorshVarBuffer $
|
||||
rustWrapperCreateTx
|
||||
(case sapAnchor of
|
||||
Nothing -> "0"
|
||||
Just sA -> toBytes $ sapTree sA)
|
||||
(case orchAnchor of
|
||||
Nothing -> "0"
|
||||
Just oA -> toBytes $ orchTree oA)
|
||||
tSpend
|
||||
sSpend
|
||||
oSpend
|
||||
outgoing
|
||||
(sapSParams sParams)
|
||||
(sapOParams oParams)
|
||||
(znet == MainNet)
|
||||
(fromIntegral bh)
|
||||
build
|
||||
0 -> pure $ Left InsufficientFunds
|
||||
1 -> pure $ Left ChangeRequired
|
||||
2 -> pure $ Left Fee
|
||||
3 -> pure $ Left Balance
|
||||
4 -> pure $ Left TransparentBuild
|
||||
5 -> pure $ Left SaplingBuild
|
||||
6 -> pure $ Left OrchardBuild
|
||||
7 -> pure $ Left OrchardSpend
|
||||
8 -> pure $ Left OrchardRecipient
|
||||
9 -> pure $ Left SaplingBuilderNotAvailable
|
||||
10 -> pure $ Left OrchardBuilderNotAvailable
|
||||
_ -> pure $ Left ZHError
|
||||
|
|
|
|||
242
test/Spec.hs
242
test/Spec.hs
|
|
@ -40,11 +40,17 @@ import GHC.Float.RealFracMethods (properFractionDoubleInteger)
|
|||
import Haskoin.Crypto.Hash (ripemd160)
|
||||
import Haskoin.Crypto.Keys.Extended
|
||||
import Haskoin.Transaction.Common
|
||||
import Network.HTTP.Simple (Response(..))
|
||||
import Test.HUnit
|
||||
import Test.Hspec
|
||||
import Test.Hspec.QuickCheck
|
||||
import Test.QuickCheck
|
||||
import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed)
|
||||
import ZcashHaskell.Keys
|
||||
( deriveUfvk
|
||||
, deriveUivk
|
||||
, generateWalletSeedPhrase
|
||||
, getWalletSeed
|
||||
)
|
||||
import ZcashHaskell.Orchard
|
||||
import ZcashHaskell.Sapling
|
||||
( decodeSaplingAddress
|
||||
|
|
@ -54,6 +60,7 @@ import ZcashHaskell.Sapling
|
|||
, genSaplingInternalAddress
|
||||
, genSaplingPaymentAddress
|
||||
, genSaplingSpendingKey
|
||||
, getSaplingFrontier
|
||||
, getSaplingNotePosition
|
||||
, getSaplingWitness
|
||||
, getShieldedOutputs
|
||||
|
|
@ -72,6 +79,7 @@ import ZcashHaskell.Types
|
|||
, OrchardAction(..)
|
||||
, OrchardBundle(..)
|
||||
, OrchardCommitmentTree(..)
|
||||
, OrchardFrontier(..)
|
||||
, OrchardSpendingKey(..)
|
||||
, OrchardWitness(..)
|
||||
, Phrase(..)
|
||||
|
|
@ -82,9 +90,12 @@ import ZcashHaskell.Types
|
|||
, RawTxOut(..)
|
||||
, RawTxResponse(..)
|
||||
, RawZebraTx(..)
|
||||
, RpcError(..)
|
||||
, RpcResponse(..)
|
||||
, SaplingAddress(..)
|
||||
, SaplingBundle(..)
|
||||
, SaplingCommitmentTree(..)
|
||||
, SaplingFrontier(..)
|
||||
, SaplingReceiver(..)
|
||||
, SaplingSpendingKey(..)
|
||||
, SaplingWitness(..)
|
||||
|
|
@ -892,34 +903,36 @@ main = do
|
|||
Just t' -> do
|
||||
let tb = zt_tBundle t'
|
||||
show tb `shouldNotBe` ""
|
||||
describe "Sapling commitment trees" $ do
|
||||
let tree =
|
||||
SaplingCommitmentTree $
|
||||
hexString
|
||||
"01916df07670600aefa3b412a120d6b8d9a3d2ff9466a7ec770cd52d34ddb42313001000013c60b031a5e44650059fcc7101a3f551b807ab8b3a116a5a9c7fa0f3babbe735017c0d36686294ff19d59e58b6a2ac6a7ad607a804bc202c84012d8e94f233970c0128dbde5180af5304d8577376d78297130b615a327974c10881f6d876869aea05011b80b4ca60f74dfe33c78b062df73c84b8b44dab4604db16f5b61eea40134373010c96e4cc8a6a80fba0d41e4eb3070d80769104dc33fb61133b1304c15bf9e23e000107114fe4bb4cd08b47f6ae47477c182d5da9fe5c189061808c1091e9bf3b4524000001447d6b9100cddd5f80c8cf4ddee2b87eba053bd987465aec2293bd0514e68b0d015f6c95e75f4601a0a31670a7deb970fc8988c611685161d2e1629d0a1a0ebd07015f8b9205e0514fa235d75c150b87e23866b882b39786852d1ab42aab11d31a4a0117ddeb3a5f8d2f6b2d0a07f28f01ab25e03a05a9319275bb86d72fcaef6fc01501f08f39275112dd8905b854170b7f247cf2df18454d4fa94e6e4f9320cca05f24011f8322ef806eb2430dc4a7a41c1b344bea5be946efc7b4349c1c9edb14ff9d39"
|
||||
let cmu1 =
|
||||
hexString
|
||||
"45e47c5df6f5c5e48aa3526e977b2d1b57eda57214e36f06128008cb17b0125f"
|
||||
let cmu2 =
|
||||
hexString
|
||||
"426ef44b3b22e0eeda7e4d2b62bac63966572b224e50f97ee56c9490cde4910d"
|
||||
let tree2 =
|
||||
hexString
|
||||
"01a47029e9b43722c57143a5d07681bff3e2315c9a28ad49d69e7c1f2f6e81ac160010000000000000012f4f72c03f8c937a94919a01a07f21165cc8394295291cb888ca91ed003810390107114fe4bb4cd08b47f6ae47477c182d5da9fe5c189061808c1091e9bf3b4524000001447d6b9100cddd5f80c8cf4ddee2b87eba053bd987465aec2293bd0514e68b0d015f6c95e75f4601a0a31670a7deb970fc8988c611685161d2e1629d0a1a0ebd07015f8b9205e0514fa235d75c150b87e23866b882b39786852d1ab42aab11d31a4a0117ddeb3a5f8d2f6b2d0a07f28f01ab25e03a05a9319275bb86d72fcaef6fc01501f08f39275112dd8905b854170b7f247cf2df18454d4fa94e6e4f9320cca05f24011f8322ef806eb2430dc4a7a41c1b344bea5be946efc7b4349c1c9edb14ff9d39"
|
||||
it "Commitment tree is updated correctly" $ do
|
||||
let t1 = updateSaplingCommitmentTree tree cmu1
|
||||
t1 `shouldNotBe` Nothing
|
||||
it "Incremental witness is generated" $ do
|
||||
let t1 = updateSaplingCommitmentTree tree cmu1
|
||||
case t1 of
|
||||
Nothing -> assertFailure "Failed to append node to tree"
|
||||
Just t -> getSaplingWitness t `shouldNotBe` Nothing
|
||||
it "Position of note is obtained" $ do
|
||||
let p =
|
||||
getSaplingNotePosition <$>
|
||||
(getSaplingWitness =<< updateSaplingCommitmentTree tree cmu1)
|
||||
p `shouldBe` Just 129405
|
||||
describe "Orchard commitment trees" $ do
|
||||
{-
|
||||
-describe "Sapling commitment trees" $ do
|
||||
- let tree =
|
||||
- SaplingCommitmentTree $
|
||||
- hexString
|
||||
- "01916df07670600aefa3b412a120d6b8d9a3d2ff9466a7ec770cd52d34ddb42313001000013c60b031a5e44650059fcc7101a3f551b807ab8b3a116a5a9c7fa0f3babbe735017c0d36686294ff19d59e58b6a2ac6a7ad607a804bc202c84012d8e94f233970c0128dbde5180af5304d8577376d78297130b615a327974c10881f6d876869aea05011b80b4ca60f74dfe33c78b062df73c84b8b44dab4604db16f5b61eea40134373010c96e4cc8a6a80fba0d41e4eb3070d80769104dc33fb61133b1304c15bf9e23e000107114fe4bb4cd08b47f6ae47477c182d5da9fe5c189061808c1091e9bf3b4524000001447d6b9100cddd5f80c8cf4ddee2b87eba053bd987465aec2293bd0514e68b0d015f6c95e75f4601a0a31670a7deb970fc8988c611685161d2e1629d0a1a0ebd07015f8b9205e0514fa235d75c150b87e23866b882b39786852d1ab42aab11d31a4a0117ddeb3a5f8d2f6b2d0a07f28f01ab25e03a05a9319275bb86d72fcaef6fc01501f08f39275112dd8905b854170b7f247cf2df18454d4fa94e6e4f9320cca05f24011f8322ef806eb2430dc4a7a41c1b344bea5be946efc7b4349c1c9edb14ff9d39"
|
||||
- let cmu1 =
|
||||
- hexString
|
||||
- "45e47c5df6f5c5e48aa3526e977b2d1b57eda57214e36f06128008cb17b0125f"
|
||||
- let cmu2 =
|
||||
- hexString
|
||||
- "426ef44b3b22e0eeda7e4d2b62bac63966572b224e50f97ee56c9490cde4910d"
|
||||
- let tree2 =
|
||||
- hexString
|
||||
- "01a47029e9b43722c57143a5d07681bff3e2315c9a28ad49d69e7c1f2f6e81ac160010000000000000012f4f72c03f8c937a94919a01a07f21165cc8394295291cb888ca91ed003810390107114fe4bb4cd08b47f6ae47477c182d5da9fe5c189061808c1091e9bf3b4524000001447d6b9100cddd5f80c8cf4ddee2b87eba053bd987465aec2293bd0514e68b0d015f6c95e75f4601a0a31670a7deb970fc8988c611685161d2e1629d0a1a0ebd07015f8b9205e0514fa235d75c150b87e23866b882b39786852d1ab42aab11d31a4a0117ddeb3a5f8d2f6b2d0a07f28f01ab25e03a05a9319275bb86d72fcaef6fc01501f08f39275112dd8905b854170b7f247cf2df18454d4fa94e6e4f9320cca05f24011f8322ef806eb2430dc4a7a41c1b344bea5be946efc7b4349c1c9edb14ff9d39"
|
||||
- it "Commitment tree is updated correctly" $ do
|
||||
- let t1 = updateSaplingCommitmentTree tree cmu1
|
||||
- t1 `shouldNotBe` Nothing
|
||||
- it "Incremental witness is generated" $ do
|
||||
- let t1 = updateSaplingCommitmentTree tree cmu1
|
||||
- case t1 of
|
||||
- Nothing -> assertFailure "Failed to append node to tree"
|
||||
- Just t -> getSaplingWitness t `shouldNotBe` Nothing
|
||||
- it "Position of note is obtained" $ do
|
||||
- let p =
|
||||
- getSaplingNotePosition <$>
|
||||
- (getSaplingWitness =<< updateSaplingCommitmentTree tree cmu1)
|
||||
- p `shouldBe` Just 129405
|
||||
-}
|
||||
{- describe "Orchard commitment trees" $ do
|
||||
let tree =
|
||||
OrchardCommitmentTree $
|
||||
hexString
|
||||
|
|
@ -939,7 +952,7 @@ main = do
|
|||
let p =
|
||||
getOrchardNotePosition <$>
|
||||
(getOrchardWitness =<< updateOrchardCommitmentTree tree cmx)
|
||||
p `shouldBe` Just 39432
|
||||
p `shouldBe` Just 39432 -}
|
||||
describe "Extract Sapling Address - UA Valid" $ do
|
||||
let sr =
|
||||
getSaplingFromUA
|
||||
|
|
@ -1058,18 +1071,22 @@ main = do
|
|||
(hexString
|
||||
"97e5f003d16720844ba1bd157688a7697133f4bb4a33a7c91974937a1351d7af56d16d4a10bd196ddda700fcd8be517f8f9e39a17ba0eea235d98450a626be3a998ac31f35e8e082106a31fe94da11d02b73748db4aa519df6bbf25c1d62a2cf0b192c6a486bca2632fee9e4124ce2dba6f3366a14850f6a3b784d863119f52458ed774f8d63105b4f6a3d2e09cc74e3a02ec8386213087b4c849172ded6724a45c9c12744ec4a0f86a29b803b17187df5dd5f90e71d1f3f4578d4e1496e8892")
|
||||
it "Sap output 1" $ do
|
||||
let pos =
|
||||
getSaplingNotePosition <$>
|
||||
(getSaplingWitness =<<
|
||||
updateSaplingCommitmentTree
|
||||
tree
|
||||
(fromText
|
||||
"fa430c51bb108db782764cff55de9c6b11bbecd2493d2e0fa9f646428feef858"))
|
||||
case pos of
|
||||
Nothing -> assertFailure "couldn't get note position"
|
||||
Just p -> do
|
||||
let dn = decodeSaplingOutputEsk sk so1 TestNet External p
|
||||
dn `shouldBe` Nothing
|
||||
case getSaplingFrontier tree of
|
||||
Nothing -> assertFailure "failed to read comm tree"
|
||||
Just tree' -> do
|
||||
let pos =
|
||||
sf_pos <$>
|
||||
updateSaplingCommitmentTree
|
||||
tree'
|
||||
(fromText
|
||||
"fa430c51bb108db782764cff55de9c6b11bbecd2493d2e0fa9f646428feef858")
|
||||
case pos of
|
||||
Nothing -> assertFailure "couldn't get note position"
|
||||
Just p -> do
|
||||
let dn =
|
||||
decodeSaplingOutputEsk sk so1 TestNet External $
|
||||
fromIntegral p
|
||||
dn `shouldBe` Nothing
|
||||
it "Sap output 2" $ do
|
||||
case readZebraTransaction txHex2 of
|
||||
Nothing -> assertFailure "Failed to read Tx"
|
||||
|
|
@ -1079,24 +1096,27 @@ main = do
|
|||
Nothing -> assertFailure "Failed to get sapling bundle"
|
||||
Just sB -> do
|
||||
let sOuts = sbOutputs sB
|
||||
let pos =
|
||||
getSaplingNotePosition <$>
|
||||
(getSaplingWitness =<<
|
||||
updateSaplingCommitmentTree
|
||||
tree
|
||||
(fromText
|
||||
"d163c69029e8cb05d874b798c7973b3b1b1b0e04f984a252b73c848698320843"))
|
||||
case pos of
|
||||
Nothing -> assertFailure "couldn't get note position"
|
||||
Just p -> do
|
||||
let dn =
|
||||
decodeSaplingOutputEsk
|
||||
sk
|
||||
(head . tail $ sOuts)
|
||||
TestNet
|
||||
External
|
||||
p
|
||||
dn `shouldBe` Nothing
|
||||
case getSaplingFrontier tree of
|
||||
Nothing -> assertFailure "Failed to read tree"
|
||||
Just tree' -> do
|
||||
let pos =
|
||||
getSaplingNotePosition <$>
|
||||
(getSaplingWitness =<<
|
||||
updateSaplingCommitmentTree
|
||||
tree'
|
||||
(fromText
|
||||
"d163c69029e8cb05d874b798c7973b3b1b1b0e04f984a252b73c848698320843"))
|
||||
case pos of
|
||||
Nothing -> assertFailure "couldn't get note position"
|
||||
Just p -> do
|
||||
let dn =
|
||||
decodeSaplingOutputEsk
|
||||
sk
|
||||
(head . tail $ sOuts)
|
||||
TestNet
|
||||
External
|
||||
p
|
||||
dn `shouldBe` Nothing
|
||||
it "Decode Sapling Output from Zingo" $ do
|
||||
case readZebraTransaction txHex of
|
||||
Nothing -> assertFailure "Failed to read Tx"
|
||||
|
|
@ -1109,24 +1129,26 @@ main = do
|
|||
Nothing -> assertFailure "Failed to get sapling bundle"
|
||||
Just sB -> do
|
||||
let sOuts = sbOutputs sB
|
||||
let pos =
|
||||
getSaplingNotePosition <$>
|
||||
(getSaplingWitness =<<
|
||||
updateSaplingCommitmentTree
|
||||
tree
|
||||
(fromText
|
||||
"d163c69029e8cb05d874b798c7973b3b1b1b0e04f984a252b73c848698320843"))
|
||||
case pos of
|
||||
Nothing -> assertFailure "couldn't get note position"
|
||||
Just p -> do
|
||||
let dn =
|
||||
decodeSaplingOutputEsk
|
||||
sK'
|
||||
(head . tail $ sOuts)
|
||||
MainNet
|
||||
External
|
||||
p
|
||||
dn `shouldNotBe` Nothing
|
||||
case getSaplingFrontier tree of
|
||||
Nothing -> assertFailure "failed to read comm tree"
|
||||
Just tree' -> do
|
||||
let pos =
|
||||
sf_pos <$>
|
||||
updateSaplingCommitmentTree
|
||||
tree'
|
||||
(fromText
|
||||
"d163c69029e8cb05d874b798c7973b3b1b1b0e04f984a252b73c848698320843")
|
||||
case pos of
|
||||
Nothing -> assertFailure "couldn't get note position"
|
||||
Just p -> do
|
||||
let dn =
|
||||
decodeSaplingOutputEsk
|
||||
sK'
|
||||
(head . tail $ sOuts)
|
||||
MainNet
|
||||
External
|
||||
(fromIntegral p)
|
||||
dn `shouldNotBe` Nothing
|
||||
describe "Generate an ExchangeAddress (MainNet) from transparent address" $ do
|
||||
let ta = decodeTransparentAddress "t1dMjvesbzdG41xgKaGU3HgwYJwSgbCK54e"
|
||||
it "Try to generate valid ExchangeAddress from Transparent Address" $ do
|
||||
|
|
@ -1143,43 +1165,35 @@ main = do
|
|||
case exch of
|
||||
Nothing -> assertFailure "Failed to encode Exchange address"
|
||||
Just addr -> do
|
||||
let eadr = decodeExchangeAddress addr
|
||||
let eadr = decodeExchangeAddress (E.encodeUtf8 addr)
|
||||
eadr `shouldNotBe` Nothing
|
||||
describe "Witness updates" $ do
|
||||
it "Sapling" $ do
|
||||
let wit =
|
||||
SaplingWitness $
|
||||
hexString
|
||||
"01bd8a3f3cfc964332a2ada8c09a0da9dfc24174befb938abb086b9be5ca049e49013607f5e51826c8e5f660571ddfae14cd6fb1dc026bcd6855459b4e9339b20521100000019f0d7efb00169bb2202152d3266059d208ab17d14642c3339f9075e997160657000000012f4f72c03f8c937a94919a01a07f21165cc8394295291cb888ca91ed003810390107114fe4bb4cd08b47f6ae47477c182d5da9fe5c189061808c1091e9bf3b4524000001447d6b9100cddd5f80c8cf4ddee2b87eba053bd987465aec2293bd0514e68b0d015f6c95e75f4601a0a31670a7deb970fc8988c611685161d2e1629d0a1a0ebd07015f8b9205e0514fa235d75c150b87e23866b882b39786852d1ab42aab11d31a4a0117ddeb3a5f8d2f6b2d0a07f28f01ab25e03a05a9319275bb86d72fcaef6fc01501f08f39275112dd8905b854170b7f247cf2df18454d4fa94e6e4f9320cca05f24011f8322ef806eb2430dc4a7a41c1b344bea5be946efc7b4349c1c9edb14ff9d39038cd7f6e2238d16ef49420963348dd4e4c7d23d5e5dac69507fba8937f63eb626f6856115bea2fa8db3a65a0ab294db41c51435d3b7ea27c7b2835aca28e82a2c1d9634efe07449a47c251518ac6f92c49f3a1ef119948f6a824d1e7ff7d0443e0101e57ec972a9b9383dc9cb228980d2d7752bb2abebc4a604ca48c5457039d2e05b000301392bed8592185dde5ab7fc81aed75e98fcf041f1a3fda55ad0b0b139ba9380130001808304b4d7c4fc407f5ce28247a7119013aeaaf1481902419c42bc8b21575c15"
|
||||
let cmus =
|
||||
[ hexString
|
||||
"958ccdc752f2f593f6c1c8e2d7201348cd896e54c6d3c92200bdbe8b859eac44"
|
||||
, hexString
|
||||
"e49992fdd071d90bf56242d1aa625bbe267a34e0debd4307818a686d05b45447"
|
||||
, hexString
|
||||
"0c4b26766d89bf6cdb4fd3b0317b4e9a2fb3850f6a24869f32fe7cb0fd512e18"
|
||||
]
|
||||
updateSaplingWitness wit cmus `shouldBe`
|
||||
SaplingWitness
|
||||
(hexString
|
||||
"01bd8a3f3cfc964332a2ada8c09a0da9dfc24174befb938abb086b9be5ca049e49013607f5e51826c8e5f660571ddfae14cd6fb1dc026bcd6855459b4e9339b20521100000019f0d7efb00169bb2202152d3266059d208ab17d14642c3339f9075e997160657000000012f4f72c03f8c937a94919a01a07f21165cc8394295291cb888ca91ed003810390107114fe4bb4cd08b47f6ae47477c182d5da9fe5c189061808c1091e9bf3b4524000001447d6b9100cddd5f80c8cf4ddee2b87eba053bd987465aec2293bd0514e68b0d015f6c95e75f4601a0a31670a7deb970fc8988c611685161d2e1629d0a1a0ebd07015f8b9205e0514fa235d75c150b87e23866b882b39786852d1ab42aab11d31a4a0117ddeb3a5f8d2f6b2d0a07f28f01ab25e03a05a9319275bb86d72fcaef6fc01501f08f39275112dd8905b854170b7f247cf2df18454d4fa94e6e4f9320cca05f24011f8322ef806eb2430dc4a7a41c1b344bea5be946efc7b4349c1c9edb14ff9d39038cd7f6e2238d16ef49420963348dd4e4c7d23d5e5dac69507fba8937f63eb626f6856115bea2fa8db3a65a0ab294db41c51435d3b7ea27c7b2835aca28e82a2c1d9634efe07449a47c251518ac6f92c49f3a1ef119948f6a824d1e7ff7d0443e0101e49992fdd071d90bf56242d1aa625bbe267a34e0debd4307818a686d05b45447010c4b26766d89bf6cdb4fd3b0317b4e9a2fb3850f6a24869f32fe7cb0fd512e1803000121c06ee1f1584f79d50785797a694c742be2ded600367ab7d54f3ed49e3adf7201808304b4d7c4fc407f5ce28247a7119013aeaaf1481902419c42bc8b21575c15")
|
||||
it "Orchard" $ do
|
||||
let wit =
|
||||
OrchardWitness $
|
||||
hexString
|
||||
"016225b41339a00dd764b452fca190a0245e7118224965942e3a6d798365c34631001f0000011d6f5da3f619bfaab957fc643c17eb144db0101c90f422da2fcbe0e80d74412e000000000001746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000040e02c864db8b574f165f616d48e2f12eb25099b5c90186af26d9e50f5058863e0504bfbc12edc35e05042c16bbfb8fed591f01f18fe128eeb57f2c456c9eb222d6d261c549e95d9007bce4c6ae0b86bc865711cdd9f0fa92e2d5b5e149b51f3be127df3b1d2372adf6c811b2e456c1d64d0e9eb167a995f9c6b66a03c9cbda250101c094201bae3b4ef582a3e8654f65a72fbd41e20e1ec9a43d3f4101afc868731e000200019df5b9366d0f21caa678d1567390b5bfd3cfa0438271bcfe301b5558a2863301"
|
||||
let cmxs =
|
||||
[ hexString
|
||||
"712ba86615ff4447e8d7c7b59f3873f03c03a173438b8e4c8d416756ed4fae10"
|
||||
, hexString
|
||||
"c094201bae3b4ef582a3e8654f65a72fbd41e20e1ec9a43d3f4101afc868731e"
|
||||
, hexString
|
||||
"ac20b8170b008888c19fc6e16f5e30a5ef1653e5219d0cd0c9353c3aa8f79823"
|
||||
]
|
||||
updateOrchardWitness wit cmxs `shouldBe`
|
||||
OrchardWitness
|
||||
(hexString
|
||||
"016225b41339a00dd764b452fca190a0245e7118224965942e3a6d798365c34631001f0000011d6f5da3f619bfaab957fc643c17eb144db0101c90f422da2fcbe0e80d74412e000000000001746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000040e02c864db8b574f165f616d48e2f12eb25099b5c90186af26d9e50f5058863e0504bfbc12edc35e05042c16bbfb8fed591f01f18fe128eeb57f2c456c9eb222d6d261c549e95d9007bce4c6ae0b86bc865711cdd9f0fa92e2d5b5e149b51f3be127df3b1d2372adf6c811b2e456c1d64d0e9eb167a995f9c6b66a03c9cbda250101c094201bae3b4ef582a3e8654f65a72fbd41e20e1ec9a43d3f4101afc868731e0002010cfb50d8c877eb39e9c07082a032dd99d34be7c19fa7f30e9fecf5f14736240f019df5b9366d0f21caa678d1567390b5bfd3cfa0438271bcfe301b5558a2863301")
|
||||
describe "Generate Viewing Keys" $ do
|
||||
let p =
|
||||
Phrase
|
||||
"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 seed = getWalletSeed p
|
||||
let oK = genOrchardSpendingKey (fromJust seed) MainNetCoin 0
|
||||
let sK = genSaplingSpendingKey (fromJust seed) MainNetCoin 0
|
||||
it "Generate FVK" $ do
|
||||
tK <- genTransparentPrvKey (fromJust seed) MainNetCoin 0
|
||||
case oK of
|
||||
Nothing -> assertFailure "Failed to generate Orchard SK"
|
||||
Just o ->
|
||||
case sK of
|
||||
Nothing -> assertFailure "Failed to generate Sapling SK"
|
||||
Just s -> do
|
||||
fvk <- deriveUfvk MainNet o s tK
|
||||
decodeUfvk (E.encodeUtf8 fvk) `shouldNotBe` Nothing
|
||||
it "Generate IVK" $ do
|
||||
tK <- genTransparentPrvKey (fromJust seed) MainNetCoin 0
|
||||
case oK of
|
||||
Nothing -> assertFailure "Failed to generate Orchard SK"
|
||||
Just o ->
|
||||
case sK of
|
||||
Nothing -> assertFailure "Failed to generate Sapling SK"
|
||||
Just s -> do
|
||||
ivk <- deriveUivk MainNet o s tK
|
||||
decodeUivk (E.encodeUtf8 ivk) `shouldNotBe` Nothing
|
||||
|
||||
-- | Properties
|
||||
prop_PhraseLength :: Property
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@ cabal-version: 3.0
|
|||
-- see: https://github.com/sol/hpack
|
||||
|
||||
name: zcash-haskell
|
||||
version: 0.6.1.1
|
||||
version: 0.7.8.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
|
||||
|
|
@ -58,7 +58,8 @@ library
|
|||
, binary
|
||||
, text
|
||||
, haskoin-core
|
||||
, secp256k1-haskell
|
||||
, secp256k1-haskell >= 1.1
|
||||
, vector
|
||||
, utf8-string
|
||||
build-tool-depends:
|
||||
c2hs:c2hs
|
||||
|
|
@ -85,5 +86,6 @@ test-suite zcash-haskell-test
|
|||
, binary
|
||||
, cryptonite
|
||||
, secp256k1-haskell
|
||||
, http-conduit
|
||||
pkgconfig-depends: rustzcash_wrapper
|
||||
default-language: Haskell2010
|
||||
|
|
|
|||
Loading…
Reference in a new issue