Compare commits

...

99 Commits

Author SHA1 Message Date
pitmutt b137b022cc
Merge pull request 'Bug fixes for beta version' (#83) from milestone2 into master
Reviewed-on: #83
2024-05-16 16:55:01 +00:00
Rene Vergara a96d713859
Bug fixes for beta version 2024-05-16 11:50:48 -05:00
Rene Vergara e4498e1b7d
Update to latest branch of ZH 2024-05-16 10:47:38 -05:00
Rene Vergara 1dc71c0d83
Merge branch 'dev041' 2024-05-10 08:28:51 -05:00
pitmutt af1ee16408
Merge pull request 'Beta release' (#79) from rav001 into dev041
Reviewed-on: #79
2024-05-10 13:19:53 +00:00
pitmutt ad1c910c95
Merge branch 'dev041' into rav001 2024-05-10 13:19:36 +00:00
pitmutt 621ffea3d9
Publish Zenith beta version (#80)
Co-authored-by: Rene V. Vergara <rvergara59@protonmail.com>
Reviewed-on: #80
Co-authored-by: pitmutt <rene@vergara.network>
Co-committed-by: pitmutt <rene@vergara.network>
2024-05-09 19:15:37 +00:00
Rene Vergara 5f0a7dc6b0
Version bump 2024-05-09 14:09:35 -05:00
Rene Vergara dd20442d44
Update installation instructions 2024-05-09 14:08:49 -05:00
pitmutt f71426d69f
Merge pull request 'Sending transactions' (#78) from rav001 into dev041
Reviewed-on: #78
2024-05-09 15:48:24 +00:00
Rene Vergara e20f253cda
Improve the fee calculation 2024-05-09 10:44:07 -05:00
Rene Vergara dcbb2fac4a
Implement background sync 2024-05-05 09:49:55 -05:00
pitmutt 1ba188ec24
Merge pull request 'Implement transaction creation' (#77) from rav001 into dev041
Reviewed-on: #77
2024-05-03 12:15:11 +00:00
Rene Vergara 84c067ec79
Implement transaction creation 2024-05-03 07:10:08 -05:00
pitmutt 8ec2fe31a4
Merge pull request 'Include display of balance and transactions' (#76) from rav001 into dev041
Reviewed-on: #76
2024-04-25 19:24:59 +00:00
Rene Vergara 900d4f9da6
Balance display and transaction display 2024-04-25 14:22:44 -05:00
Rene Vergara 53c18a833b
Fix display of last block scanned 2024-04-24 09:04:56 -05:00
Rene Vergara 07c1b85829
Add balance display to UI 2024-04-24 08:58:45 -05:00
Rene Vergara 52ac50e30c
Implement per-address tx display 2024-04-24 07:42:35 -05:00
Rene Vergara 29bed14f7c
Implement transaction display 2024-04-21 07:07:51 -05:00
Rene Vergara c6da52f594
Implement source note discovery 2024-04-17 20:28:47 -05:00
Rene Vergara 9471a861c6
Add function to check commitment trees 2024-04-09 13:32:39 -05:00
Rene Vergara 0543c1141c
Implement Shielded Output scanning 2024-04-08 15:54:09 -05:00
Rene Vergara 5ce822e52f
Migrate to Esqueleto 2024-04-07 09:25:25 -05:00
pitmutt a36de0a307
Merge pull request 'Enhancements to blockchain scanner' (#74) from rav001 into dev041
Reviewed-on: #74
2024-04-04 19:39:06 +00:00
Rene Vergara 865f7241b1
Implement progress bar for `zenscan` 2024-04-04 14:35:08 -05:00
Rene Vergara bf192a77f6
Add check of existing db for scan 2024-04-04 13:21:55 -05:00
pitmutt f2ab12238d
Merge pull request 'Implements scanning of transactions' (#73) from rav001 into dev041
Reviewed-on: #73
2024-04-03 20:20:47 +00:00
Rene Vergara a79b86cc05
Implements scanning of transactions 2024-04-03 15:14:14 -05:00
pitmutt 24fd6e2e95
Merge pull request 'Implements scanning of transparent transactions' (#72) from rav001 into dev041
Reviewed-on: #72
2024-03-27 18:40:58 +00:00
Rene Vergara b3e33b798b
Update to ZH 0.5.2.0 2024-03-27 13:38:02 -05:00
Rene Vergara f386a6b974
Merge branch 'dev041' into rav001 2024-03-22 15:40:22 -05:00
Rene Vergara de211d03b0
Add Zenith Scanner (#71)
Reviewed-on: #71
Co-authored-by: Rene Vergara <rene@vergara.network>
Co-committed-by: Rene Vergara <rene@vergara.network>
2024-03-22 20:39:37 +00:00
Rene Vergara 0a2e585eb9
Add Zenith Scanner module 2024-03-22 15:36:43 -05:00
Rene Vergara 60eee8c88d
Merge branch 'dev041' into rav001 2024-03-19 16:08:38 -05:00
Rene V. Vergara A. 75ae03458f
First commit from dev041 (#70)
Add zebra_openapi.yaml file to the zenith folder.

Co-authored-by: Rene Vergara <rene@vergara.network>
Reviewed-on: #70
Co-authored-by: Rene V. Vergara <rvergara59@protonmail.com>
Co-committed-by: Rene V. Vergara <rvergara59@protonmail.com>
2024-03-19 21:07:46 +00:00
Rene Vergara 6b48f49760
Add function process a block 2024-03-19 15:48:50 -05:00
Rene Vergara 25c6baeec1
Add new config parameter for data store 2024-03-19 15:11:32 -05:00
Rene Vergara 22f889bf86
Add new raw tx table 2024-03-19 15:09:37 -05:00
Rene Vergara 826ed5b697
Add new `Scanner` module 2024-03-19 15:09:12 -05:00
Rene Vergara c227f80dcc
Add DB wrapper for `HexString` 2024-03-19 15:08:31 -05:00
pitmutt 34cffa84bc
Merge pull request 'Implement display of seed phrase' (#69) from rav001 into dev041
Reviewed-on: #69
2024-03-18 17:27:16 +00:00
Rene Vergara 246fa05d11
Bump version 2024-03-17 14:40:49 -05:00
Rene Vergara 466491a7d0
Add command guides to screens 2024-03-17 14:38:26 -05:00
Rene Vergara bd32eb4f38
Implement internal change addresses 2024-03-17 07:17:52 -05:00
Rene Vergara 2d119d24f1
Upgrade to Zcash-Haskell 0.5 2024-03-14 12:48:39 -05:00
Rene Vergara 856ade051e
Implement wallet and account switching 2024-03-07 14:20:06 -06:00
Rene Vergara a366d3a87b
Change display of UAs per ZIP-316 2024-03-07 12:34:55 -06:00
Rene Vergara e1262bf5f7
Add error handling for account creation 2024-03-07 08:01:29 -06:00
Rene Vergara b33ba29c91
Implement address creation 2024-03-05 12:34:30 -06:00
pitmutt 7794028b55
Merge pull request 'Implement Account creation' (#68) from rav001 into dev041
Reviewed-on: #68
2024-03-01 20:59:57 +00:00
pitmutt cb63b786e8
Merge branch 'dev041' into rav001 2024-03-01 20:59:42 +00:00
Rene Vergara c522c4c3a2
Implement Account creation 2024-03-01 14:57:13 -06:00
Rene Vergara 642908a0e0
Add signature for adding accounts 2024-03-01 07:33:30 -06:00
Rene Vergara 52d3297fae
Check for accounts during startup 2024-02-29 15:02:58 -06:00
Rene Vergara 0de5dc4f9c
Avoid creating wallets with the same name 2024-02-28 16:37:43 -06:00
pitmutt 43970a8393
Merge pull request 'New Wallet creation flow' (#67) from rav001 into dev041
Reviewed-on: #67
2024-02-28 21:23:36 +00:00
Rene Vergara bb05d269ac
Add wallet creation logic 2024-02-28 15:12:57 -06:00
Rene Vergara c5a23d827c
Add tests for Accounts 2024-02-28 15:12:35 -06:00
Rene Vergara 24e73f87b3
Update installation instructions 2024-02-28 15:11:19 -06:00
Rene Vergara 488a01c46d
Make input dialog generic 2024-02-27 11:17:36 -06:00
Rene Vergara 67e303af38
Refactor TUI input dialog 2024-02-27 09:44:17 -06:00
Rene Vergara 7b7c653d02
Clean up code 2024-02-27 08:41:43 -06:00
Rene Vergara ec422c1c55
Add accounts and address tables to model 2024-02-27 08:33:12 -06:00
Rene Vergara 611f1fdd20
Update database file path config variable 2024-02-27 08:32:32 -06:00
pitmutt 7d06439bbb
Merge pull request 'Implements the custom `cabal` installation of `zcash-haskell`' (#66) from rav001 into dev041
Reviewed-on: #66
2024-02-26 16:48:43 +00:00
Rene Vergara 12be74fcd6
Implement new custom `cabal` build 2024-02-26 09:52:30 -06:00
Rene Vergara 74b9de2a9c
Update cabal.project 2024-02-25 16:29:57 -06:00
Rene Vergara 54681e8f0d
Update to new installer of `zcash-haskell` 2024-02-25 16:23:32 -06:00
pitmutt cfa81ebb89
Merge pull request 'Update `zcash-haskell` version' (#65) from rav001 into dev041
Reviewed-on: #65
2024-02-23 01:50:57 +00:00
Rene Vergara aaa10aea0f
Update `zcash-haskell` version 2024-02-22 19:49:11 -06:00
pitmutt e9aa73a51f
Merge pull request 'Update compilation toolchain to custom Cabal' (#64) from rav001 into dev041
Reviewed-on: #64
2024-02-22 22:10:57 +00:00
pitmutt 5181970e08
Merge branch 'dev041' into rav001 2024-02-22 22:10:16 +00:00
Rene Vergara 9798f675c0
Replace `stack` compilation with custom `cabal` 2024-02-22 16:06:23 -06:00
Rene Vergara a21a483ded
Add `zcash-haskell` submodule 2024-02-22 16:05:08 -06:00
Rene Vergara b8ff1eb561
Implement wallet check from DB 2024-02-19 14:05:32 -06:00
Rene Vergara e9fd87ef58
Add splash screen to TUI 2024-02-14 12:03:18 -06:00
Rene Vergara 5fec52bdd0
Add host parameter for Zebra server 2024-02-14 12:02:53 -06:00
pitmutt 9bb5a8422a
Merge pull request 'Implements a help dialog in the TUI' (#63) from rav001 into dev041
Reviewed-on: #63
2024-02-13 22:12:36 +00:00
Rene Vergara 1022944e67
Implement help dialog 2024-02-13 14:19:05 -06:00
Rene Vergara f55a724f99
Merge branch 'dev041' into rav001 2024-02-12 15:40:49 -06:00
Rene Vergara 4fd06af7fe
Update license to MIT 2024-02-12 15:39:41 -06:00
pitmutt d37e33de3f
Merge pull request 'Implement connection to Zebra RPC' (#62) from rav001 into dev041
Reviewed-on: #62
2024-02-12 21:29:15 +00:00
Rene Vergara 268d17c094
Implement functions to make RPC calls to Zebra 2024-02-12 15:14:30 -06:00
Rene Vergara 3ccee4ecb6
Add new config parameter for Zebra port 2024-02-12 15:09:12 -06:00
Rene Vergara e86e4c73ab
Update to new version of ZH 2024-02-12 15:08:36 -06:00
pitmutt 980a7c8901
Merge pull request 'Implement message window' (#61) from rav001 into dev041
Reviewed-on: #61
2024-02-11 20:16:03 +00:00
Rene Vergara 19afc808ac
Implement message window 2024-02-11 10:33:22 -06:00
pitmutt 9bb42bd7c9
Merge pull request 'CLI enhancements to manage lists of items' (#60) from rav001 into dev041
Reviewed-on: #60
2024-02-09 22:21:44 +00:00
pitmutt 8b815da018
Merge branch 'dev041' into rav001 2024-02-09 22:21:24 +00:00
Rene Vergara 1b91177a46
CLI enhancements to manage lists of items 2024-02-09 16:18:48 -06:00
pitmutt 80f873cffd
Merge pull request 'Proof-of-concept of `brick` TUI' (#59) from rav001 into dev041
Reviewed-on: #59
2024-02-08 19:30:06 +00:00
Rene Vergara e82a5e17ae
Implement POC of `brick` 2024-02-08 13:26:54 -06:00
Rene Vergara a9a9e824cd
Update to latest version of ZH 2024-02-08 12:33:48 -06:00
pitmutt 19ce971b96
Merge pull request 'fix079: SQLite implementation' (#4) from fix079 into dev041
Reviewed-on: #4
2024-01-23 15:58:31 +00:00
Rene Vergara 67e70ef1c0
Add TypeOperators pragma 2024-01-23 09:55:24 -06:00
Rene Vergara b89ee243b7
Implement DB tests for wallet 2024-01-22 12:58:37 -06:00
Rene Vergara 9a7f191d1b
Refactor existing code into modules 2024-01-17 12:15:21 -06:00
Rene Vergara dabd149df2
Account for transparent change addresses under UA 2024-01-12 08:25:23 -06:00
28 changed files with 6133 additions and 1129 deletions

3
.gitignore vendored
View File

@ -1,2 +1,3 @@
.stack-work/
*~
*~
dist-newstyle/

6
.gitmodules vendored
View File

@ -1,6 +1,4 @@
[submodule "haskoin-core"]
path = haskoin-core
url = https://github.com/khazaddum/haskoin-core.git
[submodule "zcash-haskell"]
path = zcash-haskell
url = git@git.vergara.tech:Vergara_Tech/zcash-haskell.git
url = https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
branch = milestone2

View File

@ -5,6 +5,78 @@ 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.5.2.0-beta]
### Changed
- Update to `zcash-haskell-0.6.2.0` to increase performance of transaction creation
### Fixed
- Truncation of transaction ID when displaying a successfully sent transaction
- Missing command in menu for Send
## [0.5.1.1-beta.1]
### Changed
- Installation instructions in README
## [0.5.1.1-beta]
### Added
- Implement CLI changes to send transactions
## [0.5.0.0]
### Added
- Core functions for sending transactions
## [0.4.6.0]
### Added
- Display of account balance
- Functions to identify spends
- Functions to display transactions per address
### Changed
- Update `zcash-haskell`
## [0.4.5.0]
### Added
- Functions to scan relevant transparent notes
- Functions to scan relevant Sapling notes
- Functions to scan relevant Orchard notes
- Function to query `zebrad` for commitment trees
### Changed
- Update `zcash-haskell`
## [0.4.4.3]
### Added
- `Core` module
- `CLI` module
- `DB` module
- Command line arguments to switch to legacy version
- New configuration parameter for Zebra port
- New functions to call `getinfo` and `getblockchaininfo` RPC methods
- `Scanner` module
## [0.4.1]
### Fixed
- Handling of transactions to transparent receivers
## [0.4.0]
### Added

190
LICENSE
View File

@ -1,178 +1,22 @@
Copyright (c) 2022 Vergara Technologies
MIT License
=======================================================
Bootstrap Open Source Licence ("BOSL") v. 1.0
=======================================================
This Bootstrap Open Source Licence (the "License") applies to any original work
of authorship (the "Original Work") whose owner (the "Licensor") has placed the
following licensing notice adjacent to the copyright notice for the Original
Work:
Copyright (c) 2022-2024 Vergara Technologies LLC
*Licensed under the Bootstrap Open Source Licence version 1.0*
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
1. **Grant of Copyright License.** Licensor grants You a worldwide,
royalty-free, non-exclusive, sublicensable license, for the duration of the
copyright in the Original Work, to do the following:
The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.
a. to reproduce the Original Work in copies, either alone or as part of
a collective work;
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.
b. to translate, adapt, alter, transform, modify, or arrange the
Original Work, thereby creating derivative works ("Derivative Works")
based upon the Original Work;
c. to distribute or communicate copies of the Original Work and
Derivative Works to the public, provided that prior to any such
distribution or communication You first place a machine-readable copy
of the Source Code of the Original Work and such Derivative Works that
You intend to distribute or communicate in an information repository
reasonably calculated to permit inexpensive and convenient access
thereto by the public (“Information Repository”) for as long as You
continue to distribute or communicate said copies, accompanied by an
irrevocable offer to license said copies to the public free of charge
under this License, said offer valid starting no later than 12 months
after You first distribute or communicate said copies;
d. to perform the Original Work publicly; and
e. to display the Original Work publicly.
2. **Grant of Patent License.** Licensor grants You a worldwide, royalty-free,
non-exclusive, sublicensable license, under patent claims owned or controlled
by the Licensor that are embodied in the Original Work as furnished by the
Licensor, for the duration of the patents, to make, use, sell, offer for sale,
have made, and import the Original Work and Derivative Works.
3. **Grant of Source Code License.** The "Source Code" for a work means the
preferred form of the work for making modifications to it and all available
documentation describing how to modify the work. Licensor agrees to provide a
machine-readable copy of the Source Code of the Original Work along with each
copy of the Original Work that Licensor distributes. Licensor reserves the
right to satisfy this obligation by placing a machine-readable copy of said
Source Code in an Information Repository for as long as Licensor continues to
distribute the Original Work.
4. **Exclusions From License Grant.** Neither the names of Licensor, nor the
names of any contributors to the Original Work, nor any of their trademarks or
service marks, may be used to endorse or promote products derived from this
Original Work without express prior permission of the Licensor. Except as
expressly stated herein, nothing in this License grants any license to
Licensor's trademarks, copyrights, patents, trade secrets or any other
intellectual property. No patent license is granted to make, use, sell, offer
for sale, have made, or import embodiments of any patent claims other than the
licensed claims defined in Section 2. No license is granted to the trademarks
of Licensor even if such marks are included in the Original Work. Nothing in
this License shall be interpreted to prohibit Licensor from licensing under
terms different from this License any Original Work that Licensor otherwise
would have a right to license.
5. **External Deployment.** The term "External Deployment" means the use,
distribution, or communication of the Original Work or Derivative Works in any
way such that the Original Work or Derivative Works may be used by anyone other
than You, whether those works are distributed or communicated to those persons
or made available as an application intended for use over a network. As an
express condition for the grants of license hereunder, You must treat any
External Deployment by You of the Original Work or a Derivative Work as a
distribution under section 1(c).
6. **Attribution Rights.** You must retain, in the Source Code of any
Derivative Works that You create, all copyright, patent, or trademark notices
from the Source Code of the Original Work, as well as any notices of licensing
and any descriptive text identified therein as an "Attribution Notice." You
must cause the Source Code for any Derivative Works that You create to carry a
prominent Attribution Notice reasonably calculated to inform recipients that
You have modified the Original Work.
7. **Warranty of Provenance and Disclaimer of Warranty.** Licensor warrants
that the copyright in and to the Original Work and the patent rights granted
herein by Licensor are owned by the Licensor or are sublicensed to You under
the terms of this License with the permission of the contributor(s) of those
copyrights and patent rights. Except as expressly stated in the immediately
preceding sentence, the Original Work is provided under this License on an "AS
IS" BASIS and WITHOUT WARRANTY, either express or implied, including, without
limitation, the warranties of non-infringement, merchantability or fitness for
a particular purpose. THE ENTIRE RISK AS TO THE QUALITY OF THE ORIGINAL WORK IS
WITH YOU. This DISCLAIMER OF WARRANTY constitutes an essential part of this
License. No license to the Original Work is granted by this License except
under this disclaimer.
8. **Limitation of Liability.** Under no circumstances and under no legal
theory, whether in tort (including negligence), contract, or otherwise, shall
the Licensor be liable to anyone for any indirect, special, incidental, or
consequential damages of any character arising as a result of this License or
the use of the Original Work including, without limitation, damages for loss of
goodwill, work stoppage, computer failure or malfunction, or any and all other
commercial damages or losses. This limitation of liability shall not apply to
the extent applicable law prohibits such limitation.
9. **Acceptance and Termination.** If, at any time, You expressly assented to
this License, that assent indicates your clear and irrevocable acceptance of
this License and all of its terms and conditions. If You distribute or
communicate copies of the Original Work or a Derivative Work, You must make a
reasonable effort under the circumstances to obtain the express assent of
recipients to the terms of this License. This License conditions your rights to
undertake the activities listed in Section 1, including your right to create
Derivative Works based upon the Original Work, and doing so without honoring
these terms and conditions is prohibited by copyright law and international
treaty. Nothing in this License is intended to affect copyright exceptions and
limitations (including 'fair use' or 'fair dealing'). This License shall
terminate immediately and You may no longer exercise any of the rights granted
to You by this License upon your failure to honor the conditions in Section
1(c).
10. **Termination for Patent Action.** This License shall terminate
automatically and You may no longer exercise any of the rights granted to You
by this License as of the date You commence an action, including a cross-claim
or counterclaim, against Licensor or any licensee alleging that the Original
Work infringes a patent. This termination provision shall not apply for an
action alleging patent infringement by combinations of the Original Work with
other software or hardware.
11. **Jurisdiction, Venue and Governing Law.** Any action or suit relating to
this License may be brought only in the courts of a jurisdiction wherein the
Licensor resides or in which Licensor conducts its primary business, and under
the laws of that jurisdiction excluding its conflict-of-law provisions. The
application of the United Nations Convention on Contracts for the International
Sale of Goods is expressly excluded. Any use of the Original Work outside the
scope of this License or after its termination shall be subject to the
requirements and penalties of copyright or patent law in the appropriate
jurisdiction. This section shall survive the termination of this License.
12. **Attorneys' Fees.** In any action to enforce the terms of this License or
seeking damages relating thereto, the prevailing party shall be entitled to
recover its costs and expenses, including, without limitation, reasonable
attorneys' fees and costs incurred in connection with such action, including
any appeal of such action. This section shall survive the termination of this
License.
13. **Miscellaneous.** If any provision of this License is held to be
unenforceable, such provision shall be reformed only to the extent necessary to
make it enforceable.
14. **Definition of "You" in This License.** "You" throughout this License,
whether in upper or lower case, means an individual or a legal entity
exercising rights under, and complying with all of the terms of, this License.
For legal entities, "You" includes any entity that controls, is controlled by,
or is under common control with you. For purposes of this definition, "control"
means (i) the power, direct or indirect, to cause the direction or management
of such entity, whether by contract or otherwise, or (ii) ownership of fifty
percent (50%) or more of the outstanding shares, or (iii) beneficial ownership
of such entity.
15. **Right to Use.** You may use the Original Work in all ways not otherwise
restricted or conditioned by this License or by law, and Licensor promises not
to interfere with or be responsible for such uses by You.
16. **Modification of This License.** This License is Copyright © 2007 Zooko
Wilcox-O'Hearn. Permission is granted to copy, distribute, or communicate this
License without modification. Nothing in this License permits You to modify
this License as applied to the Original Work or to Derivative Works. However,
You may modify the text of this License and copy, distribute or communicate
your modified version (the "Modified License") and apply it to other original
works of authorship subject to the following conditions: (i) You may not
indicate in any way that your Modified License is the "Bootstrap Open Source
Licence" or "BOSL" and you may not use those names in the name of your Modified
License; and (ii) You must replace the notice specified in the first paragraph
above with the notice "Licensed under <insert your license name here>" or with
a notice of your own that is not confusingly similar to the notice in this
License.

View File

@ -10,23 +10,28 @@
Zcash Full Node CLI
```
[![Please don't upload to GitHub](https://nogithub.codeberg.page/badge.svg)](https://nogithub.codeberg.page)
[![Please don't upload to GitHub](https://nogithub.codeberg.page/badge.svg)](https://nogithub.codeberg.page) ![](https://img.shields.io/badge/License-MIT-green
)
Zenith is a command-line interface for the Zcash Full Node (`zcashd`). It has the following features:
Zenith is a wallet for the [Zebra](https://zfnd.org/zebra/) Zcash node . It has the following features:
- Listing transparent and shielded addresses and balances known to the node, including viewing-only.
- Creating new wallets.
- Creating new accounts.
- Creating new Unified Addresses.
- Listing transactions for specific addresses, decoding memos for easy reading.
- Copying addresses to the clipboard.
- Creating new Unified Addresses.
- Sending transactions with shielded memo support.
Note: Zenith depends on a patched version of the `haskoin-core` Haskell package included in this repo. A pull request to the maintainers of `haskoin-core` has been submitted, if/when it is merged, Zenith will be updated to use the standard package.
## Installation
- Install dependencies:
- [Stack](https://docs.haskellstack.org/en/stable/README/#how-to-install)
- [Zcash Full Node v.5.0.0](https://zcash.readthedocs.io/en/latest/rtd_pages/zcashd.html#install)
- [Cabal](https://www.haskell.org/cabal/#install-upgrade)
- [Zebra](https://zfnd.org/zebra/)
- [Cargo](https://doc.rust-lang.org/cargo/getting-started/installation.html)
- Install `cargo-c`:
```shell
cargo install cargo-c
```
- `xclip`
- `libsecp256k1-dev`
- `libxss-dev`
@ -37,41 +42,27 @@ Note: Zenith depends on a patched version of the `haskoin-core` Haskell package
git clone https://git.vergara.tech/Vergara_Tech/zenith.git
cd zenith
git submodule init
git submodule update
git submodule update --remote
```
- Install using `stack`:
- Install using `cabal`:
```
stack install
cabal install
```
## Configuration
- Copy the sample `zenith.cfg` file to a location of your choice and update the values of the user and password for the `zcashd` node. These values can be found in the `zcash.conf` file for the Zcash node.
- Copy the sample `zenith.cfg` file to your home directory and update the values of your Zebra host and port.
## Usage
From the location where the configured `zenith.cfg` file is placed, use `zenith` to start.
**Note:** This is beta software under active development. We recommend to use it on testnet. Zenith runs on the network Zebra is running, to use the testnet you need to configure your Zebra node to run on testnet.
Zenith will attempt to connect to the node and check compatibility. Connections to `zcashd` versions less than 5.0.0 will fail.
From the location where the configured `zenith.cfg` file is placed, use `zenith cli` to start.
### Available commands
- `?`: Lists available commands.
- `list`: Lists all transparent and shielded addresses and their balance.
- Notes about balances:
- Addresses from an imported viewing key will list a balance but it may be inaccurate, as viewing keys cannot see ZEC spent out of that address.
- Balances for Unified Addresses *belonging to the same account* are shared. Zenith will list the full account balances for each of the UAs in the account.
- `txs <id>`: Lists all transactions belonging to the address corresponding to the `id` given, in chronological order.
- `copy`: Copies the selected address to the clipboard.
- `new`: Prompts the user for the option to include a transparent receiver, a Sapling receiver or both. An Orchard receiver is always included.
- `send`: Prompts the user to prepare an outgoing transaction, selecting the source address, validating the destination address, the amount and the memo.
- If the source is a transparent address, the privacy policy is set to `AllowRevealedSenders`, favoring the shielding of funds when sent to a UA.
- If the source is a shielded address, the privacy policy is set to `AllowRevealedAmounts`, favoring the move of funds from legacy shielded pools to Orchard.
- `uri`: Prompts the user to select the source account and to enter a [ZIP-321](https://zips.z.cash/zip-0321) compliant URI to generate and send a transaction.
- `exit`: Ends the session.
Zenith will attempt to connect to the node and start up, the app will guide you through the creation of the first wallet.
### Support
If you would like to support the development of Zenith, please visit our [Free2Z](https://free2z.com/zenith-full-node-cli) page.
If you would have any questions or suggestions, please join us on our [Support channel](https://matrix.to/#/#support:vergara.tech)

131
Setup.hs Normal file
View File

@ -0,0 +1,131 @@
import Control.Exception (throw)
import Control.Monad (forM_, when)
import Data.Maybe (isNothing)
import Distribution.PackageDescription
import Distribution.Simple
import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..), localPkgDescr)
import Distribution.Simple.PreProcess
import Distribution.Simple.Program.Find
( defaultProgramSearchPath
, findProgramOnSearchPath
)
import Distribution.Simple.Setup
import Distribution.Simple.Utils
( IODataMode(IODataModeBinary)
, maybeExit
, rawSystemStdInOut
)
import Distribution.Verbosity (Verbosity)
import qualified Distribution.Verbosity as Verbosity
import System.Directory
( XdgDirectory(..)
, copyFile
, createDirectory
, createDirectoryIfMissing
, doesDirectoryExist
, doesFileExist
, getCurrentDirectory
, getDirectoryContents
, getHomeDirectory
, getXdgDirectory
)
import System.Environment
import System.FilePath ((</>))
import Text.Regex
import Text.Regex.Base
main :: IO ()
main = defaultMainWithHooks hooks
where
hooks =
simpleUserHooks
{ preConf =
\_ flags -> do
prepDeps (fromFlag $ configVerbosity flags)
pure emptyHookedBuildInfo
--, confHook = \a flags -> confHook simpleUserHooks a flags >>= rsAddDirs
}
execCargo :: Verbosity -> String -> [String] -> IO ()
execCargo verbosity command args = do
cargoPath <-
findProgramOnSearchPath Verbosity.silent defaultProgramSearchPath "cargo"
dir <- getCurrentDirectory
let cargoExec =
case cargoPath of
Just (p, _) -> p
Nothing -> "cargo"
cargoArgs = command : args
workingDir = Just (dir </> rsFolder)
thirdComponent (_, _, c) = c
maybeExit . fmap thirdComponent $
rawSystemStdInOut
verbosity
cargoExec
cargoArgs
workingDir
Nothing
Nothing
IODataModeBinary
rsMake :: Verbosity -> IO ()
rsMake verbosity = do
execCargo verbosity "cbuild" []
prepDeps :: Verbosity -> IO ()
prepDeps verbosity = do
ldPath <- lookupEnv "LD_LIBRARY_PATH"
pkgPath <- lookupEnv "PKG_CONFIG_PATH"
if maybe False (matchTest (mkRegex ".*zcash-haskell.*")) ldPath &&
maybe False (matchTest (mkRegex ".*zcash-haskell.*")) pkgPath
then do
execCargo verbosity "cbuild" []
localData <- getXdgDirectory XdgData "zcash-haskell"
createDirectoryIfMissing True localData
dir <- getCurrentDirectory
let rustLibDir =
dir </> rsFolder </> "target/x86_64-unknown-linux-gnu/debug"
copyDir rustLibDir localData
else throw $
userError "Paths not set correctly, please run the 'configure' script."
rsFolder :: FilePath
rsFolder = "zcash-haskell/librustzcash-wrapper"
rsAddDirs :: LocalBuildInfo -> IO LocalBuildInfo
rsAddDirs lbi' = do
dir <- getCurrentDirectory
let rustIncludeDir =
dir </> rsFolder </> "target/x86_64-unknown-linux-gnu/debug"
rustLibDir = dir </> rsFolder </> "target/x86_64-unknown-linux-gnu/debug"
updateLbi lbi = lbi {localPkgDescr = updatePkgDescr (localPkgDescr lbi)}
updatePkgDescr pkgDescr =
pkgDescr {library = updateLib <$> library pkgDescr}
updateLib lib = lib {libBuildInfo = updateLibBi (libBuildInfo lib)}
updateLibBi libBuild =
libBuild
{ includeDirs = rustIncludeDir : includeDirs libBuild
, extraLibDirs = rustLibDir : extraLibDirs libBuild
}
pure $ updateLbi lbi'
copyDir :: FilePath -> FilePath -> IO ()
copyDir src dst = do
whenM (not <$> doesDirectoryExist src) $
throw (userError "source does not exist")
--whenM (doesFileOrDirectoryExist dst) $
--throw (userError "destination already exists")
createDirectoryIfMissing True dst
content <- getDirectoryContents src
let xs = filter (`notElem` [".", ".."]) content
forM_ xs $ \name -> do
let srcPath = src </> name
let dstPath = dst </> name
isDirectory <- doesDirectoryExist srcPath
if isDirectory
then copyDir srcPath dstPath
else copyFile srcPath dstPath
where
doesFileOrDirectoryExist x = orM [doesDirectoryExist x, doesFileExist x]
orM xs = or <$> sequence xs
whenM s r = s >>= flip when r

View File

@ -12,10 +12,16 @@ import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import Data.Time.Clock.POSIX
import System.Console.StructuredCLI
import System.Environment (getArgs)
import System.Exit
import System.IO
import Text.Read (readMaybe)
import Zenith
import ZcashHaskell.Types
import Zenith.CLI
import Zenith.Core (clearSync, testSync)
import Zenith.Types (Config(..), ZcashAddress(..), ZcashPool(..), ZcashTx(..))
import Zenith.Utils
import Zenith.Zcashd
prompt :: String -> IO String
prompt text = do
@ -194,14 +200,35 @@ processUri user pwd =
main :: IO ()
main = do
config <- load ["zenith.cfg"]
args <- getArgs
dbFilePath <- require config "dbFilePath"
nodeUser <- require config "nodeUser"
nodePwd <- require config "nodePwd"
checkServer nodeUser nodePwd
void $
runCLI
"Zenith"
def
{ getBanner =
" ______ _ _ _ \n |___ / (_) | | | \n / / ___ _ __ _| |_| |__ \n / / / _ \\ '_ \\| | __| '_ \\ \n / /_| __/ | | | | |_| | | |\n /_____\\___|_| |_|_|\\__|_| |_|\n Zcash Full Node CLI v0.4.0"
}
(root nodeUser nodePwd)
zebraPort <- require config "zebraPort"
zebraHost <- require config "zebraHost"
let myConfig = Config dbFilePath zebraHost zebraPort
if not (null args)
then do
case head args of
"legacy" -> do
checkServer nodeUser nodePwd
void $
runCLI
"Zenith"
def
{ getBanner =
" ______ _ _ _ \n |___ / (_) | | | \n / / ___ _ __ _| |_| |__ \n / / / _ \\ '_ \\| | __| '_ \\ \n / /_| __/ | | | | |_| | | |\n /_____\\___|_| |_|_|\\__|_| |_|\n Zcash Full Node CLI v0.4.0"
}
(root nodeUser nodePwd)
"cli" -> runZenithCLI myConfig
"rescan" -> clearSync myConfig
_ -> printUsage
else printUsage
printUsage :: IO ()
printUsage = do
putStrLn "zenith [command] [parameters]\n"
putStrLn "Available commands:"
putStrLn "legacy\tLegacy CLI for zcashd"
putStrLn "cli\tCLI for zebrad"
putStrLn "rescan\tRescan the existing wallet(s)"

15
app/ZenScan.hs Normal file
View File

@ -0,0 +1,15 @@
{-# LANGUAGE OverloadedStrings #-}
module ZenScan where
import Control.Monad.Logger (runNoLoggingT)
import Data.Configurator
import Zenith.Scanner (scanZebra)
main :: IO ()
main = do
config <- load ["zenith.cfg"]
dbFilePath <- require config "dbFilePath"
zebraPort <- require config "zebraPort"
zebraHost <- require config "zebraHost"
runNoLoggingT $ scanZebra 2762066 zebraHost zebraPort dbFilePath

15
cabal.project Normal file
View File

@ -0,0 +1,15 @@
packages:
./*.cabal
zcash-haskell/zcash-haskell.cabal
with-compiler: ghc-9.4.8
source-repository-package
type: git
location: https://git.vergara.tech/Vergara_Tech/haskell-hexstring.git
tag: 39d8da7b11a80269454c2f134a5c834e0f3cb9a7
source-repository-package
type: git
location: https://git.vergara.tech/Vergara_Tech/haskell-foreign-rust.git
tag: 335e804454cd30da2c526457be37e477f71e4665

6
configure vendored Executable file
View File

@ -0,0 +1,6 @@
#!/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
source ~/.bashrc
cd zcash-haskell && cabal build

View File

@ -1,76 +0,0 @@
name: zenith
version: 0.4.0
git: "https://git.vergara.tech/Vergara_Tech/zenith"
license: BOSL
author: "Rene Vergara"
maintainer: "rene@vergara.network"
copyright: "Copyright (c) 2022 Vergara Technologies LLC"
extra-source-files:
- README.md
- CHANGELOG.md
- zenith.cfg
# Metadata used when publishing your package
synopsis: Haskell CLI for Zcash Full Node
# category: Web
# To avoid duplicated efforts in documentation and dealing with the
# complications of embedding Haddock markup inside cabal files, it is
# common to point users to the README.md file.
description: Please see the README on repo at <https://git.vergara.tech/Vergara_Tech/zenith#readme>
dependencies:
- base >= 4.7 && < 5
library:
source-dirs: src
dependencies:
- aeson
- text
- bytestring
- http-conduit
- scientific
- vector
- regex-base
- regex-posix
- regex-compat
- Clipboard
- process
- http-types
- array
- base64-bytestring
- hexstring
- blake2
- zcash-haskell
executables:
zenith:
main: Main.hs
source-dirs: app
ghc-options:
- -threaded
- -rtsopts
- -with-rtsopts=-N
- -Wall
- -Wunused-imports
dependencies:
- zenith
- configurator
- structured-cli
- data-default
- bytestring
- text
- time
- sort
tests:
zenith-test:
main: Spec.hs
source-dirs: test
ghc-options:
- -threaded
- -rtsopts
- -with-rtsopts=-N
dependencies:
- zenith

BIN
sapling-output.params Normal file

Binary file not shown.

BIN
sapling-spend.params Normal file

Binary file not shown.

View File

@ -1,635 +0,0 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
module Zenith where
import Control.Concurrent (threadDelay)
import Control.Monad
import Crypto.Hash.BLAKE2.BLAKE2b
import Data.Aeson
import Data.Aeson.Types
import qualified Data.Array as A
import Data.Bits
import qualified Data.ByteString as B
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Char8 as C
import qualified Data.ByteString.Lazy as LB
import Data.Char
import Data.Functor (void)
import Data.HexString
import Data.Maybe
import qualified Data.Scientific as Scientific
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import Data.Text.Encoding.Error (lenientDecode)
import qualified Data.Text.IO as TIO
import qualified Data.Vector as V
import Data.Word
import GHC.Generics
import ZcashHaskell.Orchard (isValidUnifiedAddress)
import ZcashHaskell.Sapling (isValidShieldedAddress)
{-import Haskoin.Address.Bech32-}
import Network.HTTP.Simple
import Network.HTTP.Types
import Numeric
import System.Clipboard
import System.Exit
import System.IO
import System.Process (createProcess_, shell)
import Text.Read (readMaybe)
import Text.Regex
import Text.Regex.Base
import Text.Regex.Posix
-- | A type to model Zcash RPC calls
data RpcCall = RpcCall
{ jsonrpc :: T.Text
, id :: T.Text
, method :: T.Text
, params :: [Value]
} deriving (Show, Generic, ToJSON, FromJSON)
-- | Type for modelling the different address sources for Zcash 5.0.0
data AddressSource
= LegacyRandom
| Imported
| ImportedWatchOnly
| KeyPool
| LegacySeed
| MnemonicSeed
deriving (Read, Show, Eq, Generic, ToJSON)
instance FromJSON AddressSource where
parseJSON =
withText "AddressSource" $ \case
"legacy_random" -> return LegacyRandom
"imported" -> return Imported
"imported_watchonly" -> return ImportedWatchOnly
"keypool" -> return KeyPool
"legacy_hdseed" -> return LegacySeed
"mnemonic_seed" -> return MnemonicSeed
_ -> fail "Not a known address source"
data ZcashPool
= Transparent
| Sprout
| Sapling
| Orchard
deriving (Show, Eq, Generic, ToJSON)
instance FromJSON ZcashPool where
parseJSON =
withText "ZcashPool" $ \case
"p2pkh" -> return Transparent
"sprout" -> return Sprout
"sapling" -> return Sapling
"orchard" -> return Orchard
_ -> fail "Not a known Zcash pool"
data ZcashAddress = ZcashAddress
{ source :: AddressSource
, pool :: [ZcashPool]
, account :: Maybe Integer
, addy :: T.Text
} deriving (Eq)
instance Show ZcashAddress where
show (ZcashAddress s p i a) =
T.unpack (T.take 8 a) ++
"..." ++ T.unpack (T.takeEnd 8 a) ++ " Pools: " ++ show p
-- | A type to model the response of the Zcash RPC
data RpcResponse r = RpcResponse
{ err :: Maybe T.Text
, respId :: T.Text
, result :: r
} deriving (Show, Generic, ToJSON)
instance (FromJSON r) => FromJSON (RpcResponse r) where
parseJSON (Object obj) = do
e <- obj .: "error"
rId <- obj .: "id"
r <- obj .: "result"
pure $ RpcResponse e rId r
parseJSON invalid =
prependFailure
"parsing RpcResponse failed, "
(typeMismatch "Object" invalid)
newtype NodeVersion =
NodeVersion Integer
deriving (Eq, Show)
instance FromJSON NodeVersion where
parseJSON =
withObject "NodeVersion" $ \obj -> do
v <- obj .: "version"
pure $ NodeVersion v
-- | A type to model an address group
data AddressGroup = AddressGroup
{ agsource :: AddressSource
, agtransparent :: [ZcashAddress]
, agsapling :: [ZcashAddress]
, agunified :: [ZcashAddress]
} deriving (Show, Generic)
instance FromJSON AddressGroup where
parseJSON =
withObject "AddressGroup" $ \obj -> do
s <- obj .: "source"
t <- obj .:? "transparent"
sap <- obj .:? "sapling"
uni <- obj .:? "unified"
sL <- processSapling sap s
tL <- processTransparent t s
uL <- processUnified uni
return $ AddressGroup s tL (concat sL) (concat uL)
where
processTransparent c s1 =
case c of
Nothing -> return []
Just x -> do
x' <- x .: "addresses"
return $ map (ZcashAddress s1 [Transparent] Nothing) x'
processSapling k s2 =
case k of
Nothing -> return []
Just y -> mapM (processOneSapling s2) y
where processOneSapling sx =
withObject "Sapling" $ \oS -> do
oS' <- oS .: "addresses"
return $ map (ZcashAddress sx [Sapling] Nothing) oS'
processUnified u =
case u of
Nothing -> return []
Just z -> mapM processOneAccount z
where processOneAccount =
withObject "UAs" $ \uS -> do
acct <- uS .: "account"
uS' <- uS .: "addresses"
mapM (processUAs acct) uS'
where
processUAs a =
withObject "UAs" $ \v -> do
addr <- v .: "address"
p <- v .: "receiver_types"
return $ ZcashAddress MnemonicSeed p a addr
displayZec :: Integer -> String
displayZec s
| s < 100 = show s ++ " zats "
| s < 100000 = show (fromIntegral s / 100) ++ " μZEC "
| s < 100000000 = show (fromIntegral s / 100000) ++ " mZEC "
| otherwise = show (fromIntegral s / 100000000) ++ " ZEC "
-- | A type to model a Zcash transaction
data ZcashTx = ZcashTx
{ ztxid :: T.Text
, zamount :: Double
, zamountZat :: Integer
, zblockheight :: Integer
, zblocktime :: Integer
, zchange :: Bool
, zconfirmations :: Integer
, zmemo :: T.Text
} deriving (Show, Generic)
instance FromJSON ZcashTx where
parseJSON =
withObject "ZcashTx" $ \obj -> do
t <- obj .: "txid"
a <- obj .: "amount"
aZ <- obj .: "amountZat"
bh <- obj .: "blockheight"
bt <- obj .: "blocktime"
c <- obj .:? "change"
conf <- obj .: "confirmations"
m <- obj .:? "memo"
pure $
ZcashTx
t
a
aZ
bh
bt
(fromMaybe False c)
conf
(case m of
Nothing -> ""
Just m' -> T.filter (/= '\NUL') $ decodeHexText m')
instance ToJSON ZcashTx where
toJSON (ZcashTx t a aZ bh bt c conf m) =
object
[ "amount" .= a
, "amountZat" .= aZ
, "txid" .= t
, "blockheight" .= bh
, "blocktime" .= bt
, "change" .= c
, "confirmations" .= conf
, "memo" .= m
]
-- | Type for the UA balance
data UABalance = UABalance
{ uatransparent :: Integer
, uasapling :: Integer
, uaorchard :: Integer
} deriving (Eq)
instance Show UABalance where
show (UABalance t s o) =
" T: " ++ show t ++ " S: " ++ show s ++ " O: " ++ show o
instance FromJSON UABalance where
parseJSON =
withObject "UABalance" $ \obj -> do
p <- obj .: "pools"
t <- p .:? "transparent"
s <- p .:? "sapling"
o <- p .:? "orchard"
vT <-
case t of
Nothing -> return 0
Just t' -> t' .: "valueZat"
vS <-
case s of
Nothing -> return 0
Just s' -> s' .: "valueZat"
vO <-
case o of
Nothing -> return 0
Just o' -> o' .: "valueZat"
pure $ UABalance vT vS vO
-- | Type for Operation Result
data OpResult = OpResult
{ opsuccess :: T.Text
, opmessage :: Maybe T.Text
, optxid :: Maybe T.Text
} deriving (Show, Eq)
instance FromJSON OpResult where
parseJSON =
withObject "OpResult" $ \obj -> do
s <- obj .: "status"
r <- obj .:? "result"
e <- obj .:? "error"
t <-
case r of
Nothing -> return Nothing
Just r' -> r' .: "txid"
m <-
case e of
Nothing -> return Nothing
Just m' -> m' .: "message"
pure $ OpResult s m t
-- | Helper function to turn a hex-encoded memo strings to readable text
decodeHexText :: String -> T.Text
decodeHexText h = E.decodeUtf8With lenientDecode $ B.pack $ hexRead h
where
hexRead hexText
| null chunk = []
| otherwise =
fromIntegral (read ("0x" <> chunk)) : hexRead (drop 2 hexText)
where
chunk = take 2 hexText
-- | Helper function to turn a string into a hex-encoded string
encodeHexText :: String -> String
encodeHexText t = mconcat (map padHex t)
where
padHex x =
if ord x < 16
then "0" ++ (showHex . ord) x ""
else showHex (ord x) ""
encodeHexText' :: T.Text -> String
encodeHexText' t =
if T.length t > 0
then T.unpack . toText . fromBytes $ E.encodeUtf8 t
else T.unpack . toText . fromBytes $ E.encodeUtf8 "Sent from Zenith"
-- | Helper function to extract addresses from AddressGroups
getAddresses :: AddressGroup -> [ZcashAddress]
getAddresses ag = agtransparent ag <> agsapling ag <> agunified ag
-- | Helper function to validate potential Zcash addresses
validateAddress :: T.Text -> Maybe ZcashPool
validateAddress txt --(tReg || sReg && isJust chk) || (uReg && isJust chk)
| tReg = Just Transparent
| sReg && chkS = Just Sapling
| uReg && chk = Just Orchard
| otherwise = Nothing
where
transparentRegex = "^t1[a-zA-Z0-9]{33}$" :: String
shieldedRegex = "^zs[a-zA-Z0-9]{76}$" :: String
unifiedRegex = "^u[a-zA-Z0-9]" :: String
tReg = T.unpack txt =~ transparentRegex :: Bool
sReg = T.unpack txt =~ shieldedRegex :: Bool
uReg = T.unpack txt =~ unifiedRegex :: Bool
chk = isValidUnifiedAddress $ E.encodeUtf8 txt
chkS = isValidShieldedAddress $ E.encodeUtf8 txt
-- | RPC methods
-- | List addresses
listAddresses :: B.ByteString -> B.ByteString -> IO [ZcashAddress]
listAddresses user pwd = do
response <- makeZcashCall user pwd "listaddresses" []
let rpcResp = decode response :: Maybe (RpcResponse [AddressGroup])
case rpcResp of
Nothing -> fail "Couldn't parse node response"
Just res -> do
let addys = result res
let addList = concatMap getAddresses addys
return addList
-- | Get address balance
getBalance :: B.ByteString -> B.ByteString -> ZcashAddress -> IO [Integer]
getBalance user pwd zadd = do
let a = account zadd
case a of
Nothing -> do
response <-
makeZcashCall
user
pwd
"z_getbalance"
[ String (addy zadd)
, Number (Scientific.scientific 1 0)
, Data.Aeson.Bool True
]
let rpcResp = decode response :: Maybe (RpcResponse Integer)
case rpcResp of
Nothing -> fail "Couldn't parse node response"
Just res -> do
return [result res]
Just acct -> do
response <-
makeZcashCall
user
pwd
"z_getbalanceforaccount"
[Number (Scientific.scientific acct 0)]
let rpcResp = decode response :: Maybe (RpcResponse UABalance)
case rpcResp of
Nothing -> fail "Couldn't parse node response"
Just res -> do
return $ readUABalance (result res)
where readUABalance ua =
[uatransparent ua, uasapling ua, uaorchard ua]
-- | List transactions
listTxs :: B.ByteString -> B.ByteString -> ZcashAddress -> IO [ZcashTx]
listTxs user pwd zaddy = do
response <-
makeZcashCall user pwd "z_listreceivedbyaddress" [String $ addy zaddy]
let rpcResp = decode response :: Maybe (RpcResponse [ZcashTx])
case rpcResp of
Nothing -> fail "listTxs: Couldn't parse node response"
Just res -> do
return $ result res
-- | Send Tx
sendTx ::
B.ByteString
-> B.ByteString
-> ZcashAddress
-> T.Text
-> Double
-> Maybe T.Text
-> IO ()
sendTx user pwd fromAddy toAddy amount memo = do
bal <- getBalance user pwd fromAddy
let valAdd = validateAddress toAddy
if sum bal - floor (amount * 100000000) >= 1000
then do
if source fromAddy /= ImportedWatchOnly
then do
let privacyPolicy
| valAdd == Just Transparent = "AllowRevealedRecipients"
| isNothing (account fromAddy) &&
elem Transparent (pool fromAddy) = "AllowRevealedSenders"
| otherwise = "AllowRevealedAmounts"
let pd =
case memo of
Nothing ->
[ Data.Aeson.String (addy fromAddy)
, Data.Aeson.Array
(V.fromList
[object ["address" .= toAddy, "amount" .= amount]])
, Data.Aeson.Number $ Scientific.scientific 1 1
, Data.Aeson.Null
, Data.Aeson.String privacyPolicy
]
Just memo' ->
[ Data.Aeson.String (addy fromAddy)
, Data.Aeson.Array
(V.fromList
[ object
[ "address" .= toAddy
, "amount" .= amount
, "memo" .= encodeHexText' memo'
]
])
, Data.Aeson.Number $ Scientific.scientific 1 1
, Data.Aeson.Null
, Data.Aeson.String privacyPolicy
]
response <- makeZcashCall user pwd "z_sendmany" pd
let rpcResp = decode response :: Maybe (RpcResponse T.Text)
case rpcResp of
Nothing -> fail "Couldn't parse node response"
Just res -> do
putStr " Sending."
checkOpResult user pwd (result res)
else putStrLn "Error: Source address is view-only."
else putStrLn "Error: Insufficient balance in source address."
-- | Make a Zcash RPC call
makeZcashCall ::
B.ByteString
-> B.ByteString
-> T.Text
-> [Data.Aeson.Value]
-> IO LB.ByteString
makeZcashCall username password m p = do
let payload = RpcCall "1.0" "test" m p
let myRequest =
setRequestBodyJSON payload $
setRequestPort 8232 $
setRequestBasicAuth username password $
setRequestMethod "POST" defaultRequest
response <- httpLBS myRequest
let respStatus = getResponseStatusCode response
let body = getResponseBody response
case respStatus of
500 -> do
let rpcResp = decode body :: Maybe (RpcResponse String)
case rpcResp of
Nothing -> fail $ "Unknown server error " ++ show response
Just x -> fail (result x)
401 -> fail "Incorrect full node credentials"
200 -> return body
_ -> fail "Unknown error"
-- | Display an address
displayZcashAddress ::
B.ByteString -> B.ByteString -> (Int, ZcashAddress) -> IO ()
displayZcashAddress user pwd (idx, zaddy) = do
zats <- getBalance user pwd zaddy
putStr $ show idx ++ ": "
putStr $ show zaddy
when (source zaddy == ImportedWatchOnly) (putStr "[VK]")
putStr " Balance: "
mapM_ (putStr . displayZec) zats
putStrLn ""
-- | Copy an address to the clipboard
copyAddress :: ZcashAddress -> IO ()
copyAddress a =
void $
createProcess_ "toClipboard" $
shell $ "echo " ++ T.unpack (addy a) ++ " | xclip -r -selection clipboard"
-- | Verify operation result
checkOpResult :: B.ByteString -> B.ByteString -> T.Text -> IO ()
checkOpResult user pwd opid = do
response <-
makeZcashCall
user
pwd
"z_getoperationstatus"
[Data.Aeson.Array (V.fromList [Data.Aeson.String opid])]
let rpcResp = decode response :: Maybe (RpcResponse [OpResult])
case rpcResp of
Nothing -> fail "Couldn't parse node response"
Just res -> do
let r = result res
mapM_ showResult r
where
showResult t =
case opsuccess t of
"success" ->
putStrLn $ " Success! Tx ID: " ++ maybe "" T.unpack (optxid t)
"executing" -> do
putStr "."
hFlush stdout
threadDelay 1000000 >> checkOpResult user pwd opid
_ -> putStrLn $ " Failed :( " ++ maybe "" T.unpack (opmessage t)
-- | Check for accounts
checkAccounts :: B.ByteString -> B.ByteString -> IO Bool
checkAccounts user pwd = do
response <- makeZcashCall user pwd "z_listaccounts" []
let rpcResp = decode response :: Maybe (RpcResponse [Object])
case rpcResp of
Nothing -> fail "Couldn't parse node response"
Just res -> do
let r = result res
return $ not (null r)
-- | Add account to node
createAccount :: B.ByteString -> B.ByteString -> IO ()
createAccount user pwd = do
response <- makeZcashCall user pwd "z_getnewaccount" []
let rpcResp = decode response :: Maybe (RpcResponse Object)
case rpcResp of
Nothing -> fail "Couldn't parse node response"
Just res -> do
let r = result res
putStrLn " Account created!"
-- | Create new Unified Address
createUnifiedAddress :: B.ByteString -> B.ByteString -> Bool -> Bool -> IO ()
createUnifiedAddress user pwd tRec sRec = do
let recs = getReceivers tRec sRec
let pd = [Data.Aeson.Number $ Scientific.scientific 0 1, recs]
newResp <- makeZcashCall user pwd "z_getaddressforaccount" pd
let rpcResp = decode newResp :: Maybe (RpcResponse Object)
case rpcResp of
Nothing -> fail "Couldn't parse node response"
Just res -> do
let r = result res
putStrLn " New UA created!"
where
getReceivers t s
| t && s =
Data.Aeson.Array
(V.fromList
[ Data.Aeson.String "p2pkh"
, Data.Aeson.String "sapling"
, Data.Aeson.String "orchard"
])
| t =
Data.Aeson.Array
(V.fromList [Data.Aeson.String "p2pkh", Data.Aeson.String "orchard"])
| s =
Data.Aeson.Array
(V.fromList [Data.Aeson.String "sapling", Data.Aeson.String "orchard"])
| otherwise = Data.Aeson.Array (V.fromList [Data.Aeson.String "orchard"])
-- | Check Zcash full node server
checkServer :: B.ByteString -> B.ByteString -> IO ()
checkServer user pwd = do
resp <- makeZcashCall user pwd "getinfo" []
let rpcResp = decode resp :: Maybe (RpcResponse NodeVersion)
case rpcResp of
Nothing -> fail "Couldn't parse node response"
Just myResp -> do
let r = result myResp
if isNodeValid r
then putStrLn $ "Connected to Zcash Full Node (" <> show r <> ") :)"
else do
putStrLn "Deprecated Zcash Full Node version found. Exiting"
exitFailure
where isNodeValid (NodeVersion i) = i >= 5000000
-- | Read ZIP-321 URI
sendWithUri ::
B.ByteString -> B.ByteString -> ZcashAddress -> String -> Bool -> IO ()
sendWithUri user pwd fromAddy uri repTo = do
let uriRegex = mkRegex "^zcash:(\\w+)\\?amount=(.*)\\&memo=(.*)$"
if matchTest uriRegex uri
then do
let reg = matchAllText uriRegex uri
let parsedAddress = fst $ head reg A.! 1
let parsedAmount = fst $ head reg A.! 2
let parsedEncodedMemo = fst $ head reg A.! 3
let addType = validateAddress $ T.pack parsedAddress
case addType of
Nothing -> putStrLn " Invalid address"
Just Transparent -> do
putStrLn $ " Address is valid: " ++ parsedAddress
case (readMaybe parsedAmount :: Maybe Double) of
Nothing -> putStrLn " Invalid amount."
Just amt -> do
putStrLn $ " Valid ZEC amount: " ++ show amt
sendTx user pwd fromAddy (T.pack parsedAddress) amt Nothing
Just _ -> do
putStrLn $ " Address is valid: " ++ parsedAddress
case (readMaybe parsedAmount :: Maybe Double) of
Nothing -> putStrLn " Invalid amount."
Just amt -> do
putStrLn $ " Valid ZEC amount: " ++ show amt
let decodedMemo =
E.decodeUtf8With lenientDecode $
B64.decodeLenient $ C.pack parsedEncodedMemo
TIO.putStrLn $ " Memo: " <> decodedMemo
sendTx
user
pwd
fromAddy
(T.pack parsedAddress)
amt
(if repTo
then Just $
T.concat [decodedMemo, "\nReply-To:\n", addy fromAddy]
else Just decodedMemo)
else putStrLn "URI is not compliant with ZIP-321"

1286
src/Zenith/CLI.hs Normal file

File diff suppressed because it is too large Load Diff

774
src/Zenith/Core.hs Normal file
View File

@ -0,0 +1,774 @@
{-# LANGUAGE OverloadedStrings #-}
-- | Core wallet functionality for Zenith
module Zenith.Core where
import Control.Exception (throwIO, try)
import Control.Monad (forM, when)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger
( LoggingT
, MonadLoggerIO
, NoLoggingT
, logDebugN
, logErrorN
, logInfoN
, logWarnN
, runFileLoggingT
, runNoLoggingT
, runStdoutLoggingT
)
import Crypto.Secp256k1 (SecKey(..))
import Data.Aeson
import Data.Binary.Get hiding (getBytes)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import Data.Digest.Pure.MD5
import Data.HexString (HexString, hexString, toBytes)
import Data.List
import Data.Maybe (fromJust)
import Data.Pool (Pool)
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import Data.Time
import qualified Database.Esqueleto.Experimental as ESQ
import Database.Persist
import Database.Persist.Sqlite
import GHC.Float.RealFracMethods (floorFloatInteger)
import Haskoin.Crypto.Keys (XPrvKey(..))
import Lens.Micro ((&), (.~), (^.), set)
import Network.HTTP.Client
import ZcashHaskell.Keys
import ZcashHaskell.Orchard
( decryptOrchardActionSK
, encodeUnifiedAddress
, genOrchardReceiver
, genOrchardSpendingKey
, getOrchardNotePosition
, getOrchardWitness
, isValidUnifiedAddress
, updateOrchardCommitmentTree
, updateOrchardWitness
)
import ZcashHaskell.Sapling
( decodeSaplingOutputEsk
, genSaplingInternalAddress
, genSaplingPaymentAddress
, genSaplingSpendingKey
, getSaplingNotePosition
, getSaplingWitness
, updateSaplingCommitmentTree
, updateSaplingWitness
)
import ZcashHaskell.Transparent
( genTransparentPrvKey
, genTransparentReceiver
, genTransparentSecretKey
)
import ZcashHaskell.Types
import ZcashHaskell.Utils
import Zenith.DB
import Zenith.Types
( Config(..)
, HexStringDB(..)
, OrchardSpendingKeyDB(..)
, PhraseDB(..)
, RseedDB(..)
, SaplingSpendingKeyDB(..)
, ScopeDB(..)
, TransparentSpendingKeyDB(..)
, UnifiedAddressDB(..)
, ZcashNetDB(..)
, ZebraTreeInfo(..)
)
-- * Zebra Node interaction
-- | Checks the status of the `zebrad` node
checkZebra ::
T.Text -- ^ Host where `zebrad` is available
-> Int -- ^ Port where `zebrad` is available
-> IO ZebraGetInfo
checkZebra nodeHost nodePort = do
res <- makeZebraCall nodeHost nodePort "getinfo" []
case res of
Left e -> throwIO $ userError e
Right bi -> return bi
-- | Checks the status of the Zcash blockchain
checkBlockChain ::
T.Text -- ^ Host where `zebrad` is available
-> Int -- ^ Port where `zebrad` is available
-> IO ZebraGetBlockChainInfo
checkBlockChain nodeHost nodePort = do
r <- makeZebraCall nodeHost nodePort "getblockchaininfo" []
case r of
Left e -> throwIO $ userError e
Right bci -> return bci
-- | Get commitment trees from Zebra
getCommitmentTrees ::
T.Text -- ^ Host where `zebrad` is avaiable
-> Int -- ^ Port where `zebrad` is available
-> Int -- ^ Block height
-> IO ZebraTreeInfo
getCommitmentTrees nodeHost nodePort block = do
r <-
makeZebraCall
nodeHost
nodePort
"z_gettreestate"
[Data.Aeson.String $ T.pack $ show block]
case r of
Left e -> throwIO $ userError e
Right zti -> return zti
-- * Spending Keys
-- | Create an Orchard Spending Key for the given wallet and account index
createOrchardSpendingKey :: ZcashWallet -> Int -> IO OrchardSpendingKey
createOrchardSpendingKey zw i = do
let s = getWalletSeed $ getPhrase $ zcashWalletSeedPhrase zw
case s of
Nothing -> throwIO $ userError "Unable to generate seed"
Just s' -> do
let coinType =
case getNet $ zcashWalletNetwork zw of
MainNet -> MainNetCoin
TestNet -> TestNetCoin
RegTestNet -> RegTestNetCoin
let r = genOrchardSpendingKey s' coinType i
case r of
Nothing -> throwIO $ userError "Unable to generate Orchard spending key"
Just sk -> return sk
-- | Create a Sapling spending key for the given wallet and account index
createSaplingSpendingKey :: ZcashWallet -> Int -> IO SaplingSpendingKey
createSaplingSpendingKey zw i = do
let s = getWalletSeed $ getPhrase $ zcashWalletSeedPhrase zw
case s of
Nothing -> throwIO $ userError "Unable to generate seed"
Just s' -> do
let coinType =
case getNet $ zcashWalletNetwork zw of
MainNet -> MainNetCoin
TestNet -> TestNetCoin
RegTestNet -> RegTestNetCoin
let r = genSaplingSpendingKey s' coinType i
case r of
Nothing -> throwIO $ userError "Unable to generate Sapling spending key"
Just sk -> return sk
createTransparentSpendingKey :: ZcashWallet -> Int -> IO TransparentSpendingKey
createTransparentSpendingKey zw i = do
let s = getWalletSeed $ getPhrase $ zcashWalletSeedPhrase zw
case s of
Nothing -> throwIO $ userError "Unable to generate seed"
Just s' -> do
let coinType =
case getNet $ zcashWalletNetwork zw of
MainNet -> MainNetCoin
TestNet -> TestNetCoin
RegTestNet -> RegTestNetCoin
genTransparentPrvKey s' coinType i
-- * Accounts
-- | Create an account for the given wallet and account index
createZcashAccount ::
T.Text -- ^ The account's name
-> Int -- ^ The account's index
-> Entity ZcashWallet -- ^ The Zcash wallet that this account will be attached to
-> IO ZcashAccount
createZcashAccount n i zw = do
orSk <- createOrchardSpendingKey (entityVal zw) i
sapSk <- createSaplingSpendingKey (entityVal zw) i
tSk <- createTransparentSpendingKey (entityVal zw) i
return $
ZcashAccount
i
(entityKey zw)
n
(OrchardSpendingKeyDB orSk)
(SaplingSpendingKeyDB sapSk)
(TransparentSpendingKeyDB tSk)
-- * Addresses
-- | Create an external unified address for the given account and index
createWalletAddress ::
T.Text -- ^ The address nickname
-> Int -- ^ The address' index
-> ZcashNet -- ^ The network for this address
-> Scope -- ^ External or Internal
-> Entity ZcashAccount -- ^ The Zcash account that the address will be attached to
-> IO WalletAddress
createWalletAddress n i zNet scope za = do
let oRec =
genOrchardReceiver i scope $
getOrchSK $ zcashAccountOrchSpendKey $ entityVal za
let sRec =
case scope of
External ->
genSaplingPaymentAddress i $
getSapSK $ zcashAccountSapSpendKey $ entityVal za
Internal ->
genSaplingInternalAddress $
getSapSK $ zcashAccountSapSpendKey $ entityVal za
tRec <-
genTransparentReceiver i scope $
getTranSK $ zcashAccountTPrivateKey $ entityVal za
return $
WalletAddress
i
(entityKey za)
n
(UnifiedAddressDB $
encodeUnifiedAddress $ UnifiedAddress zNet oRec sRec (Just tRec))
(ScopeDB scope)
-- * Wallet
-- | Find the Sapling notes that match the given spending key
findSaplingOutputs ::
Config -- ^ the configuration parameters
-> Int -- ^ the starting block
-> ZcashNetDB -- ^ The network
-> Entity ZcashAccount -- ^ The account to use
-> IO ()
findSaplingOutputs config b znet za = do
let dbPath = c_dbPath config
let zebraHost = c_zebraHost config
let zebraPort = c_zebraPort config
let zn = getNet znet
pool <- runNoLoggingT $ initPool dbPath
tList <- getShieldedOutputs pool b
trees <- getCommitmentTrees zebraHost zebraPort (b - 1)
let sT = SaplingCommitmentTree $ ztiSapling trees
decryptNotes sT zn pool tList
sapNotes <- getWalletSapNotes pool (entityKey za)
findSapSpends pool (entityKey za) sapNotes
where
sk :: SaplingSpendingKeyDB
sk = zcashAccountSapSpendKey $ entityVal za
decryptNotes ::
SaplingCommitmentTree
-> ZcashNet
-> ConnectionPool
-> [(Entity ZcashTransaction, Entity ShieldOutput)]
-> IO ()
decryptNotes _ _ _ [] = return ()
decryptNotes st n pool ((zt, o):txs) = do
let updatedTree =
updateSaplingCommitmentTree
st
(getHex $ shieldOutputCmu $ entityVal o)
case updatedTree of
Nothing -> throwIO $ userError "Failed to update commitment tree"
Just uT -> do
let noteWitness = getSaplingWitness uT
let notePos = getSaplingNotePosition <$> noteWitness
case notePos of
Nothing -> throwIO $ userError "Failed to obtain note position"
Just nP -> do
case decodeShOut External n nP o of
Nothing -> do
case decodeShOut Internal n nP o of
Nothing -> do
decryptNotes uT n pool txs
Just dn1 -> do
wId <- saveWalletTransaction pool (entityKey za) zt
saveWalletSapNote
pool
wId
nP
(fromJust noteWitness)
True
(entityKey za)
(entityKey o)
dn1
decryptNotes uT n pool txs
Just dn0 -> do
wId <- saveWalletTransaction pool (entityKey za) zt
saveWalletSapNote
pool
wId
nP
(fromJust noteWitness)
False
(entityKey za)
(entityKey o)
dn0
decryptNotes uT n pool txs
decodeShOut ::
Scope
-> ZcashNet
-> Integer
-> Entity ShieldOutput
-> Maybe DecodedNote
decodeShOut scope n pos s = do
decodeSaplingOutputEsk
(getSapSK sk)
(ShieldedOutput
(getHex $ shieldOutputCv $ entityVal s)
(getHex $ shieldOutputCmu $ entityVal s)
(getHex $ shieldOutputEphKey $ entityVal s)
(getHex $ shieldOutputEncCipher $ entityVal s)
(getHex $ shieldOutputOutCipher $ entityVal s)
(getHex $ shieldOutputProof $ entityVal s))
n
scope
pos
-- | Get Orchard actions
findOrchardActions ::
Config -- ^ the configuration parameters
-> Int -- ^ the starting block
-> ZcashNetDB -- ^ The network
-> Entity ZcashAccount -- ^ The account to use
-> IO ()
findOrchardActions config b znet za = do
let dbPath = c_dbPath config
let zebraHost = c_zebraHost config
let zebraPort = c_zebraPort config
let zn = getNet znet
pool <- runNoLoggingT $ initPool dbPath
tList <- getOrchardActions pool b
trees <- getCommitmentTrees zebraHost zebraPort (b - 1)
let sT = OrchardCommitmentTree $ ztiOrchard trees
decryptNotes sT zn pool tList
orchNotes <- getWalletOrchNotes pool (entityKey za)
findOrchSpends pool (entityKey za) orchNotes
where
decryptNotes ::
OrchardCommitmentTree
-> ZcashNet
-> ConnectionPool
-> [(Entity ZcashTransaction, Entity OrchAction)]
-> IO ()
decryptNotes _ _ _ [] = return ()
decryptNotes ot n pool ((zt, o):txs) = do
let updatedTree =
updateOrchardCommitmentTree
ot
(getHex $ orchActionCmx $ entityVal o)
case updatedTree of
Nothing -> throwIO $ userError "Failed to update commitment tree"
Just uT -> do
let noteWitness = getOrchardWitness uT
let notePos = getOrchardNotePosition <$> noteWitness
case notePos of
Nothing -> throwIO $ userError "Failed to obtain note position"
Just nP ->
case decodeOrchAction External nP o of
Nothing ->
case decodeOrchAction Internal nP o of
Nothing -> decryptNotes uT n pool txs
Just dn1 -> do
wId <- saveWalletTransaction pool (entityKey za) zt
saveWalletOrchNote
pool
wId
nP
(fromJust noteWitness)
True
(entityKey za)
(entityKey o)
dn1
decryptNotes uT n pool txs
Just dn -> do
wId <- saveWalletTransaction pool (entityKey za) zt
saveWalletOrchNote
pool
wId
nP
(fromJust noteWitness)
False
(entityKey za)
(entityKey o)
dn
decryptNotes uT n pool txs
sk :: OrchardSpendingKeyDB
sk = zcashAccountOrchSpendKey $ entityVal za
decodeOrchAction ::
Scope -> Integer -> Entity OrchAction -> Maybe DecodedNote
decodeOrchAction scope pos o =
decryptOrchardActionSK (getOrchSK sk) scope $
OrchardAction
(getHex $ orchActionNf $ entityVal o)
(getHex $ orchActionRk $ entityVal o)
(getHex $ orchActionCmx $ entityVal o)
(getHex $ orchActionEphKey $ entityVal o)
(getHex $ orchActionEncCipher $ entityVal o)
(getHex $ orchActionOutCipher $ entityVal o)
(getHex $ orchActionCv $ entityVal o)
(getHex $ orchActionAuth $ entityVal o)
updateSaplingWitnesses :: ConnectionPool -> IO ()
updateSaplingWitnesses pool = do
sapNotes <- getUnspentSapNotes pool
maxId <- liftIO $ getMaxSaplingNote pool
mapM_ (updateOneNote maxId) sapNotes
where
updateOneNote :: ShieldOutputId -> Entity WalletSapNote -> IO ()
updateOneNote maxId n = do
let noteSync = walletSapNoteWitPos $ entityVal n
when (noteSync < maxId) $ do
cmus <- liftIO $ getSaplingCmus pool $ walletSapNoteWitPos $ entityVal n
let cmuList = map (\(ESQ.Value x) -> getHex x) cmus
let newWitness =
updateSaplingWitness
(SaplingWitness $ getHex $ walletSapNoteWitness $ entityVal n)
cmuList
liftIO $ updateSapNoteRecord pool (entityKey n) newWitness maxId
updateOrchardWitnesses :: ConnectionPool -> IO ()
updateOrchardWitnesses pool = do
orchNotes <- getUnspentOrchNotes pool
maxId <- getMaxOrchardNote pool
mapM_ (updateOneNote maxId) orchNotes
where
updateOneNote :: OrchActionId -> Entity WalletOrchNote -> IO ()
updateOneNote maxId n = do
let noteSync = walletOrchNoteWitPos $ entityVal n
when (noteSync < maxId) $ do
cmxs <- liftIO $ getOrchardCmxs pool noteSync
let cmxList = map (\(ESQ.Value x) -> getHex x) cmxs
let newWitness =
updateOrchardWitness
(OrchardWitness $ getHex $ walletOrchNoteWitness $ entityVal n)
cmxList
liftIO $ updateOrchNoteRecord pool (entityKey n) newWitness maxId
-- | Calculate fee per ZIP-317
calculateTxFee ::
([Entity WalletTrNote], [Entity WalletSapNote], [Entity WalletOrchNote])
-> Int
-> Integer
calculateTxFee (t, s, o) i =
fromIntegral
(5000 * (max (length t) tout + max (length s) sout + length o + oout))
where
tout =
if i == 1 || i == 2
then 1
else 0
sout =
if i == 3
then 1
else 0
oout =
if i == 4
then 1
else 0
-- | Prepare a transaction for sending
prepareTx ::
ConnectionPool
-> T.Text
-> Int
-> ZcashNet
-> ZcashAccountId
-> Int
-> Float
-> UnifiedAddress
-> T.Text
-> LoggingT IO (Either TxError HexString)
prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
accRead <- liftIO $ getAccountById pool za
let recipient =
case o_rec ua of
Nothing ->
case s_rec ua of
Nothing ->
case t_rec ua of
Nothing -> (0, "")
Just r3 ->
case tr_type r3 of
P2PKH -> (1, toBytes $ tr_bytes r3)
P2SH -> (2, toBytes $ tr_bytes r3)
Just r2 -> (3, getBytes r2)
Just r1 -> (4, getBytes r1)
logDebugN $ T.pack $ show recipient
logDebugN $ T.pack $ "Target block: " ++ show bh
trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh
let sT = SaplingCommitmentTree $ ztiSapling trees
let oT = OrchardCommitmentTree $ ztiOrchard trees
case accRead of
Nothing -> do
logErrorN "Can't find Account"
return $ Left ZHError
Just acc -> do
logDebugN $ T.pack $ show acc
spParams <- liftIO $ BS.readFile "sapling-spend.params"
outParams <- liftIO $ BS.readFile "sapling-output.params"
if show (md5 $ LBS.fromStrict spParams) /=
"0f44c12ef115ae019decf18ade583b20"
then logErrorN "Can't validate sapling parameters"
else logInfoN "Valid Sapling spend params"
if show (md5 $ LBS.fromStrict outParams) /=
"924daf81b87a81bbbb9c7d18562046c8"
then logErrorN "Can't validate sapling parameters"
else logInfoN "Valid Sapling output params"
--print $ BS.length spParams
--print $ BS.length outParams
logDebugN "Read Sapling params"
let zats = fromIntegral $ floorFloatInteger $ amt * (10 ^ 8)
logDebugN $ T.pack $ show zats
{-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
--let fee = calculateTxFee firstPass $ fst recipient
--logDebugN $ T.pack $ "calculated fee " ++ show fee
(tList, sList, oList) <- liftIO $ selectUnspentNotes pool za (zats + 5000)
logDebugN "selected notes"
logDebugN $ T.pack $ show tList
logDebugN $ T.pack $ show sList
logDebugN $ T.pack $ show oList
let noteTotal = getTotalAmount (tList, sList, oList)
tSpends <-
liftIO $
prepTSpends (getTranSK $ zcashAccountTPrivateKey $ entityVal acc) tList
--print tSpends
sSpends <-
liftIO $
prepSSpends (getSapSK $ zcashAccountSapSpendKey $ entityVal acc) sList
--print sSpends
oSpends <-
liftIO $
prepOSpends (getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) oList
--print oSpends
dummy <-
liftIO $ makeOutgoing acc recipient zats (noteTotal - 5000 - zats)
logDebugN "Calculating fee"
let feeResponse =
createTransaction
(Just sT)
(Just oT)
tSpends
sSpends
oSpends
dummy
(SaplingSpendParams spParams)
(SaplingOutputParams outParams)
zn
(bh + 3)
False
case feeResponse of
Left e1 -> return $ Left Fee
Right fee -> do
let feeAmt =
fromIntegral (runGet getInt64le $ LBS.fromStrict $ toBytes fee)
(tList1, sList1, oList1) <-
liftIO $ selectUnspentNotes pool za (zats + feeAmt)
logDebugN $ T.pack $ "selected notes with fee" ++ show feeAmt
logDebugN $ T.pack $ show tList
logDebugN $ T.pack $ show sList
logDebugN $ T.pack $ show oList
outgoing <-
liftIO $ makeOutgoing acc recipient zats (noteTotal - feeAmt - zats)
logDebugN $ T.pack $ show outgoing
let tx =
createTransaction
(Just sT)
(Just oT)
tSpends
sSpends
oSpends
outgoing
(SaplingSpendParams spParams)
(SaplingOutputParams outParams)
zn
(bh + 3)
True
return tx
where
makeOutgoing ::
Entity ZcashAccount
-> (Int, BS.ByteString)
-> Integer
-> Integer
-> IO [OutgoingNote]
makeOutgoing acc (k, recvr) zats chg = do
chgAddr <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc
let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr
let chgRcvr =
fromJust $ o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
return
[ OutgoingNote
4
(getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
(getBytes chgRcvr)
(fromIntegral chg)
""
True
, OutgoingNote
(fromIntegral k)
(case k of
4 ->
getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc
3 ->
getBytes $ getSapSK $ zcashAccountSapSpendKey $ entityVal acc
_ -> "")
recvr
(fromIntegral zats)
(E.encodeUtf8 memo)
False
]
getTotalAmount ::
( [Entity WalletTrNote]
, [Entity WalletSapNote]
, [Entity WalletOrchNote])
-> Integer
getTotalAmount (t, s, o) =
sum (map (fromIntegral . walletTrNoteValue . entityVal) t) +
sum (map (fromIntegral . walletSapNoteValue . entityVal) s) +
sum (map (fromIntegral . walletOrchNoteValue . entityVal) o)
prepTSpends ::
TransparentSpendingKey
-> [Entity WalletTrNote]
-> IO [TransparentTxSpend]
prepTSpends sk notes = do
forM notes $ \n -> do
tAddRead <- getAddressById pool $ walletTrNoteAddress $ entityVal n
case tAddRead of
Nothing -> throwIO $ userError "Couldn't read t-address"
Just tAdd -> do
(XPrvKey _ _ _ _ (SecKey xp_key)) <-
genTransparentSecretKey
(walletAddressIndex $ entityVal tAdd)
(getScope $ walletAddressScope $ entityVal tAdd)
sk
mReverseTxId <- getWalletTxId pool $ walletTrNoteTx $ entityVal n
case mReverseTxId of
Nothing -> throwIO $ userError "failed to get tx ID"
Just (ESQ.Value reverseTxId) -> do
let flipTxId = BS.reverse $ toBytes $ getHex reverseTxId
return $
TransparentTxSpend
xp_key
(RawOutPoint
flipTxId
(fromIntegral $ walletTrNotePosition $ entityVal n))
(RawTxOut
(walletTrNoteValue $ entityVal n)
(walletTrNoteScript $ entityVal n))
prepSSpends ::
SaplingSpendingKey -> [Entity WalletSapNote] -> IO [SaplingTxSpend]
prepSSpends sk notes = do
forM notes $ \n -> do
return $
SaplingTxSpend
(getBytes sk)
(DecodedNote
(fromIntegral $ walletSapNoteValue $ entityVal n)
(walletSapNoteRecipient $ entityVal n)
(E.encodeUtf8 $ walletSapNoteMemo $ entityVal n)
(getHex $ walletSapNoteNullifier $ entityVal n)
""
(getRseed $ walletSapNoteRseed $ entityVal n))
(toBytes $ getHex $ walletSapNoteWitness $ entityVal n)
prepOSpends ::
OrchardSpendingKey -> [Entity WalletOrchNote] -> IO [OrchardTxSpend]
prepOSpends sk notes = do
forM notes $ \n -> do
return $
OrchardTxSpend
(getBytes sk)
(DecodedNote
(fromIntegral $ walletOrchNoteValue $ entityVal n)
(walletOrchNoteRecipient $ entityVal n)
(E.encodeUtf8 $ walletOrchNoteMemo $ entityVal n)
(getHex $ walletOrchNoteNullifier $ entityVal n)
(walletOrchNoteRho $ entityVal n)
(getRseed $ walletOrchNoteRseed $ entityVal n))
(toBytes $ getHex $ walletOrchNoteWitness $ entityVal n)
sapAnchor :: [Entity WalletSapNote] -> Maybe SaplingWitness
sapAnchor notes =
if not (null notes)
then Just $
SaplingWitness $
getHex $ walletSapNoteWitness $ entityVal $ head notes
else Nothing
orchAnchor :: [Entity WalletOrchNote] -> Maybe OrchardWitness
orchAnchor notes =
if not (null notes)
then Just $
OrchardWitness $
getHex $ walletOrchNoteWitness $ entityVal $ head notes
else Nothing
-- | Sync the wallet with the data store
syncWallet ::
Config -- ^ configuration parameters
-> Entity ZcashWallet
-> IO ()
syncWallet config w = do
startTime <- liftIO getCurrentTime
let walletDb = c_dbPath config
pool <- runNoLoggingT $ initPool walletDb
accs <- runNoLoggingT $ getAccounts pool $ entityKey w
addrs <- concat <$> mapM (runNoLoggingT . getAddresses pool . entityKey) accs
intAddrs <-
concat <$> mapM (runNoLoggingT . getInternalAddresses pool . entityKey) accs
chainTip <- runNoLoggingT $ getMaxBlock pool
let lastBlock = zcashWalletLastSync $ entityVal w
let startBlock =
if lastBlock > 0
then lastBlock
else zcashWalletBirthdayHeight $ entityVal w
mapM_ (liftIO . findTransparentNotes pool startBlock) addrs
mapM_ (liftIO . findTransparentNotes pool startBlock) intAddrs
mapM_ (liftIO . findTransparentSpends pool . entityKey) accs
sapNotes <-
liftIO $
mapM
(findSaplingOutputs config startBlock (zcashWalletNetwork $ entityVal w))
accs
orchNotes <-
liftIO $
mapM
(findOrchardActions config startBlock (zcashWalletNetwork $ entityVal w))
accs
_ <- updateSaplingWitnesses pool
_ <- updateOrchardWitnesses pool
_ <- liftIO $ updateWalletSync pool chainTip (entityKey w)
mapM_ (runNoLoggingT . getWalletTransactions pool) addrs
testSync :: Config -> IO ()
testSync config = do
let dbPath = c_dbPath config
_ <- initDb dbPath
pool <- runNoLoggingT $ initPool dbPath
w <- getWallets pool TestNet
r <- mapM (syncWallet config) w
liftIO $ print r
{-let uaRead =-}
{-isValidUnifiedAddress-}
{-"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"-}
{-case uaRead of-}
{-Nothing -> print "wrong address"-}
{-Just ua -> do-}
{-startTime <- getCurrentTime-}
{-print startTime-}
{-tx <--}
{-prepareTx-}
{-"zenith.db"-}
{-"127.0.0.1"-}
{-18232-}
{-TestNet-}
{-(toSqlKey 1)-}
{-2820897-}
{-0.04-}
{-ua-}
{-"sent with Zenith, test"-}
{-print tx-}
{-endTime <- getCurrentTime-}
{-print endTime-}
{-testSend :: IO ()-}
{-testSend = do-}
clearSync :: Config -> IO ()
clearSync config = do
let dbPath = c_dbPath config
pool <- runNoLoggingT $ initPool dbPath
_ <- initDb dbPath
_ <- clearWalletTransactions pool
w <- getWallets pool TestNet
liftIO $ mapM_ (updateWalletSync pool 0 . entityKey) w
w' <- liftIO $ getWallets pool TestNet
r <- mapM (syncWallet config) w'
liftIO $ print r

1471
src/Zenith/DB.hs Normal file

File diff suppressed because it is too large Load Diff

157
src/Zenith/Scanner.hs Normal file
View File

@ -0,0 +1,157 @@
{-# LANGUAGE OverloadedStrings #-}
module Zenith.Scanner where
import Control.Exception (throwIO, try)
import qualified Control.Monad.Catch as CM (try)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger
( LoggingT
, NoLoggingT
, logErrorN
, logInfoN
, runNoLoggingT
)
import Data.Aeson
import Data.HexString
import Data.Maybe
import qualified Data.Text as T
import Data.Time (getCurrentTime)
import Database.Persist.Sqlite
import GHC.Utils.Monad (concatMapM)
import Lens.Micro ((&), (.~), (^.), set)
import System.Console.AsciiProgress
import ZcashHaskell.Types
( BlockResponse(..)
, RawZebraTx(..)
, Transaction(..)
, ZebraGetBlockChainInfo(..)
, ZebraTxResponse(..)
, fromRawOBundle
, fromRawSBundle
, fromRawTBundle
)
import ZcashHaskell.Utils (getBlockTime, makeZebraCall, readZebraTransaction)
import Zenith.Core (checkBlockChain)
import Zenith.DB (getMaxBlock, initDb, saveTransaction)
import Zenith.Utils (jsonNumber)
-- | Function to scan the Zcash blockchain through the Zebra node and populate the Zenith database
scanZebra ::
Int -- ^ Starting block
-> T.Text -- ^ Host
-> Int -- ^ Port
-> T.Text -- ^ Path to database file
-> NoLoggingT IO ()
scanZebra b host port dbFilePath = do
_ <- liftIO $ initDb dbFilePath
startTime <- liftIO getCurrentTime
logInfoN $ "Started sync: " <> T.pack (show startTime)
bc <-
liftIO $ try $ checkBlockChain host port :: NoLoggingT
IO
(Either IOError ZebraGetBlockChainInfo)
case bc of
Left e -> logErrorN $ T.pack (show e)
Right bStatus -> do
let dbInfo =
mkSqliteConnectionInfo dbFilePath & extraPragmas .~
["read_uncommited = true"]
pool <- createSqlitePoolFromInfo dbInfo 5
dbBlock <- getMaxBlock pool
let sb = max dbBlock b
if sb > zgb_blocks bStatus || sb < 1
then liftIO $ throwIO $ userError "Invalid starting block for scan"
else do
liftIO $
print $
"Scanning from " ++
show (sb + 1) ++ " to " ++ show (zgb_blocks bStatus)
let bList = [(sb + 1) .. (zgb_blocks bStatus)]
displayConsoleRegions $ do
pg <-
liftIO $
newProgressBar def {pgTotal = fromIntegral $ length bList}
txList <-
CM.try $ mapM_ (processBlock host port pool pg) bList :: NoLoggingT
IO
(Either IOError ())
case txList of
Left e1 -> logErrorN $ T.pack (show e1)
Right txList' -> logInfoN "Finished scan"
-- | Function to process a raw block and extract the transaction information
processBlock ::
T.Text -- ^ Host name for `zebrad`
-> Int -- ^ Port for `zebrad`
-> ConnectionPool -- ^ DB file path
-> ProgressBar -- ^ Progress bar
-> Int -- ^ The block number to process
-> NoLoggingT IO ()
processBlock host port pool pg b = do
r <-
liftIO $
makeZebraCall
host
port
"getblock"
[Data.Aeson.String $ T.pack $ show b, jsonNumber 1]
case r of
Left e -> liftIO $ throwIO $ userError e
Right blk -> do
r2 <-
liftIO $
makeZebraCall
host
port
"getblock"
[Data.Aeson.String $ T.pack $ show b, jsonNumber 0]
case r2 of
Left e2 -> liftIO $ throwIO $ userError e2
Right hb -> do
let blockTime = getBlockTime hb
mapM_ (processTx host port blockTime pool) $
bl_txs $ addTime blk blockTime
liftIO $ tick pg
where
addTime :: BlockResponse -> Int -> BlockResponse
addTime bl t =
BlockResponse
(bl_confirmations bl)
(bl_height bl)
(fromIntegral t)
(bl_txs bl)
-- | Function to process a raw transaction
processTx ::
T.Text -- ^ Host name for `zebrad`
-> Int -- ^ Port for `zebrad`
-> Int -- ^ Block time
-> ConnectionPool -- ^ DB file path
-> HexString -- ^ transaction id
-> NoLoggingT IO ()
processTx host port bt pool t = do
r <-
liftIO $
makeZebraCall
host
port
"getrawtransaction"
[Data.Aeson.String $ toText t, jsonNumber 1]
case r of
Left e -> liftIO $ throwIO $ userError e
Right rawTx -> do
case readZebraTransaction (ztr_hex rawTx) of
Nothing -> return ()
Just rzt -> do
_ <-
saveTransaction pool bt $
Transaction
t
(ztr_blockheight rawTx)
(ztr_conf rawTx)
(fromIntegral $ zt_expiry rzt)
(fromRawTBundle $ zt_tBundle rzt)
(fromRawSBundle $ zt_sBundle rzt)
(fromRawOBundle $ zt_oBundle rzt)
return ()

350
src/Zenith/Types.hs Normal file
View File

@ -0,0 +1,350 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
module Zenith.Types where
import Data.Aeson
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Char8 as C
import Data.HexString
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import Data.Text.Encoding.Error (lenientDecode)
import Database.Persist.TH
import GHC.Generics
import ZcashHaskell.Types
( OrchardSpendingKey(..)
, Phrase(..)
, Rseed(..)
, SaplingSpendingKey(..)
, Scope(..)
, TransparentSpendingKey
, ZcashNet(..)
)
-- * UI
-- * Database field type wrappers
newtype HexStringDB = HexStringDB
{ getHex :: HexString
} deriving newtype (Eq, Show, Read)
derivePersistField "HexStringDB"
newtype ZcashNetDB = ZcashNetDB
{ getNet :: ZcashNet
} deriving newtype (Eq, Show, Read)
derivePersistField "ZcashNetDB"
newtype UnifiedAddressDB = UnifiedAddressDB
{ getUA :: T.Text
} deriving newtype (Eq, Show, Read)
derivePersistField "UnifiedAddressDB"
newtype PhraseDB = PhraseDB
{ getPhrase :: Phrase
} deriving newtype (Eq, Show, Read)
derivePersistField "PhraseDB"
newtype ScopeDB = ScopeDB
{ getScope :: Scope
} deriving newtype (Eq, Show, Read)
derivePersistField "ScopeDB"
newtype OrchardSpendingKeyDB = OrchardSpendingKeyDB
{ getOrchSK :: OrchardSpendingKey
} deriving newtype (Eq, Show, Read)
derivePersistField "OrchardSpendingKeyDB"
newtype SaplingSpendingKeyDB = SaplingSpendingKeyDB
{ getSapSK :: SaplingSpendingKey
} deriving newtype (Eq, Show, Read)
derivePersistField "SaplingSpendingKeyDB"
newtype TransparentSpendingKeyDB = TransparentSpendingKeyDB
{ getTranSK :: TransparentSpendingKey
} deriving newtype (Eq, Show, Read)
derivePersistField "TransparentSpendingKeyDB"
newtype RseedDB = RseedDB
{ getRseed :: Rseed
} deriving newtype (Eq, Show, Read)
derivePersistField "RseedDB"
-- * RPC
-- | Type for Configuration parameters
data Config = Config
{ c_dbPath :: !T.Text
, c_zebraHost :: !T.Text
, c_zebraPort :: !Int
} deriving (Eq, Prelude.Show)
-- ** `zebrad`
-- | Type for modeling the tree state response
data ZebraTreeInfo = ZebraTreeInfo
{ ztiHeight :: !Int
, ztiTime :: !Int
, ztiSapling :: !HexString
, ztiOrchard :: !HexString
} deriving (Eq, Show, Read)
instance FromJSON ZebraTreeInfo where
parseJSON =
withObject "ZebraTreeInfo" $ \obj -> do
h <- obj .: "height"
t <- obj .: "time"
s <- obj .: "sapling"
o <- obj .: "orchard"
sc <- s .: "commitments"
oc <- o .: "commitments"
sf <- sc .: "finalState"
ocf <- oc .: "finalState"
pure $ ZebraTreeInfo h t sf ocf
-- ** `zcashd`
-- | Type for modelling the different address sources for `zcashd` 5.0.0
data AddressSource
= LegacyRandom
| Imported
| ImportedWatchOnly
| KeyPool
| LegacySeed
| MnemonicSeed
deriving (Read, Show, Eq, Generic, ToJSON)
instance FromJSON AddressSource where
parseJSON =
withText "AddressSource" $ \case
"legacy_random" -> return LegacyRandom
"imported" -> return Imported
"imported_watchonly" -> return ImportedWatchOnly
"keypool" -> return KeyPool
"legacy_hdseed" -> return LegacySeed
"mnemonic_seed" -> return MnemonicSeed
_ -> fail "Not a known address source"
data ZcashPool
= Transparent
| Sprout
| Sapling
| Orchard
deriving (Show, Eq, Generic, ToJSON)
instance FromJSON ZcashPool where
parseJSON =
withText "ZcashPool" $ \case
"p2pkh" -> return Transparent
"sprout" -> return Sprout
"sapling" -> return Sapling
"orchard" -> return Orchard
_ -> fail "Not a known Zcash pool"
data ZcashAddress = ZcashAddress
{ source :: AddressSource
, pool :: [ZcashPool]
, account :: Maybe Integer
, addy :: T.Text
} deriving (Eq)
instance Show ZcashAddress where
show (ZcashAddress s p i a) =
T.unpack (T.take 8 a) ++
"..." ++ T.unpack (T.takeEnd 8 a) ++ " Pools: " ++ show p
newtype NodeVersion =
NodeVersion Integer
deriving (Eq, Show)
instance FromJSON NodeVersion where
parseJSON =
withObject "NodeVersion" $ \obj -> do
v <- obj .: "version"
pure $ NodeVersion v
-- | A type to model an address group
data AddressGroup = AddressGroup
{ agsource :: !AddressSource
, agtransparent :: ![ZcashAddress]
, agsapling :: ![ZcashAddress]
, agunified :: ![ZcashAddress]
} deriving (Show, Generic)
instance FromJSON AddressGroup where
parseJSON =
withObject "AddressGroup" $ \obj -> do
s <- obj .: "source"
t <- obj .:? "transparent"
sap <- obj .:? "sapling"
uni <- obj .:? "unified"
sL <- processSapling sap s
tL <- processTransparent t s
uL <- processUnified uni
return $ AddressGroup s tL (concat sL) (concat uL)
where
processTransparent c s1 =
case c of
Nothing -> return []
Just x -> do
x' <- x .:? "addresses"
return $ maybe [] (map (ZcashAddress s1 [Transparent] Nothing)) x'
processSapling k s2 =
case k of
Nothing -> return []
Just y -> mapM (processOneSapling s2) y
where processOneSapling sx =
withObject "Sapling" $ \oS -> do
oS' <- oS .: "addresses"
return $ map (ZcashAddress sx [Sapling] Nothing) oS'
processUnified u =
case u of
Nothing -> return []
Just z -> mapM processOneAccount z
where processOneAccount =
withObject "UAs" $ \uS -> do
acct <- uS .: "account"
uS' <- uS .: "addresses"
mapM (processUAs acct) uS'
where
processUAs a =
withObject "UAs" $ \v -> do
addr <- v .: "address"
p <- v .: "receiver_types"
return $ ZcashAddress MnemonicSeed p a addr
-- | A type to model a Zcash transaction
data ZcashTx = ZcashTx
{ ztxid :: !T.Text
, zamount :: !Double
, zamountZat :: !Integer
, zblockheight :: !Integer
, zblocktime :: !Integer
, zchange :: !Bool
, zconfirmations :: !Integer
, zmemo :: !T.Text
} deriving (Show, Generic)
instance FromJSON ZcashTx where
parseJSON =
withObject "ZcashTx" $ \obj -> do
t <- obj .: "txid"
a <- obj .: "amount"
aZ <- obj .: "amountZat"
bh <- obj .: "blockheight"
bt <- obj .: "blocktime"
c <- obj .:? "change"
conf <- obj .: "confirmations"
m <- obj .:? "memo"
pure $
ZcashTx
t
a
aZ
bh
bt
(fromMaybe False c)
conf
(case m of
Nothing -> ""
Just m' -> T.filter (/= '\NUL') $ decodeHexText m')
instance ToJSON ZcashTx where
toJSON (ZcashTx t a aZ bh bt c conf m) =
object
[ "amount" .= a
, "amountZat" .= aZ
, "txid" .= t
, "blockheight" .= bh
, "blocktime" .= bt
, "change" .= c
, "confirmations" .= conf
, "memo" .= m
]
-- | Type for the UA balance
data UABalance = UABalance
{ uatransparent :: !Integer
, uasapling :: !Integer
, uaorchard :: !Integer
} deriving (Eq)
instance Show UABalance where
show (UABalance t s o) =
" T: " ++ show t ++ " S: " ++ show s ++ " O: " ++ show o
instance FromJSON UABalance where
parseJSON =
withObject "UABalance" $ \obj -> do
p <- obj .: "pools"
t <- p .:? "transparent"
s <- p .:? "sapling"
o <- p .:? "orchard"
vT <-
case t of
Nothing -> return 0
Just t' -> t' .: "valueZat"
vS <-
case s of
Nothing -> return 0
Just s' -> s' .: "valueZat"
vO <-
case o of
Nothing -> return 0
Just o' -> o' .: "valueZat"
pure $ UABalance vT vS vO
-- | Type for Operation Result
data OpResult = OpResult
{ opsuccess :: !T.Text
, opmessage :: !(Maybe T.Text)
, optxid :: !(Maybe T.Text)
} deriving (Show, Eq)
instance FromJSON OpResult where
parseJSON =
withObject "OpResult" $ \obj -> do
s <- obj .: "status"
r <- obj .:? "result"
e <- obj .:? "error"
t <-
case r of
Nothing -> return Nothing
Just r' -> r' .: "txid"
m <-
case e of
Nothing -> return Nothing
Just m' -> m' .: "message"
pure $ OpResult s m t
-- * Helper functions
-- | Helper function to turn a hex-encoded memo strings to readable text
decodeHexText :: String -> T.Text
decodeHexText h = E.decodeUtf8With lenientDecode $ BS.pack $ hexRead h
where
hexRead hexText
| null chunk = []
| otherwise =
fromIntegral (read ("0x" <> chunk)) : hexRead (drop 2 hexText)
where
chunk = take 2 hexText
-- | Helper function to turn a text into a hex-encoded string
encodeHexText' :: T.Text -> String
encodeHexText' t =
if T.length t > 0
then C.unpack . B64.encode $ E.encodeUtf8 t
else C.unpack . B64.encode $ E.encodeUtf8 "Sent from Zenith"

74
src/Zenith/Utils.hs Normal file
View File

@ -0,0 +1,74 @@
{-# LANGUAGE OverloadedStrings #-}
module Zenith.Utils where
import Data.Aeson
import Data.Functor (void)
import Data.Maybe
import Data.Scientific (Scientific(..), scientific)
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import System.Process (createProcess_, shell)
import Text.Regex.Posix
import ZcashHaskell.Orchard (encodeUnifiedAddress, isValidUnifiedAddress)
import ZcashHaskell.Sapling (isValidShieldedAddress)
import Zenith.Types
( AddressGroup(..)
, UnifiedAddressDB(..)
, ZcashAddress(..)
, ZcashPool(..)
)
-- | Helper function to convert numbers into JSON
jsonNumber :: Int -> Value
jsonNumber i = Number $ scientific (fromIntegral i) 0
-- | Helper function to display small amounts of ZEC
displayZec :: Integer -> String
displayZec s
| abs s < 100 = show s ++ " zats "
| abs s < 100000 = show (fromIntegral s / 100) ++ " μZEC "
| abs s < 100000000 = show (fromIntegral s / 100000) ++ " mZEC "
| otherwise = show (fromIntegral s / 100000000) ++ " ZEC "
-- | Helper function to display small amounts of ZEC
displayTaz :: Integer -> String
displayTaz s
| abs s < 100 = show s ++ " tazs "
| abs s < 100000 = show (fromIntegral s / 100) ++ " μTAZ "
| abs s < 100000000 = show (fromIntegral s / 100000) ++ " mTAZ "
| otherwise = show (fromIntegral s / 100000000) ++ " TAZ "
-- | Helper function to display abbreviated Unified Address
showAddress :: UnifiedAddressDB -> T.Text
showAddress u = T.take 20 t <> "..."
where
t = getUA u
-- | Helper function to extract addresses from AddressGroups
getAddresses :: AddressGroup -> [ZcashAddress]
getAddresses ag = agtransparent ag <> agsapling ag <> agunified ag
-- | Helper function to validate potential Zcash addresses
validateAddress :: T.Text -> Maybe ZcashPool
validateAddress txt --(tReg || sReg && isJust chk) || (uReg && isJust chk)
| tReg = Just Transparent
| sReg && chkS = Just Sapling
| uReg && chk = Just Orchard
| otherwise = Nothing
where
transparentRegex = "^t1[a-zA-Z0-9]{33}$" :: String
shieldedRegex = "^zs[a-zA-Z0-9]{76}$" :: String
unifiedRegex = "^u[a-zA-Z0-9]" :: String
tReg = T.unpack txt =~ transparentRegex :: Bool
sReg = T.unpack txt =~ shieldedRegex :: Bool
uReg = T.unpack txt =~ unifiedRegex :: Bool
chk = isJust $ isValidUnifiedAddress $ E.encodeUtf8 txt
chkS = isValidShieldedAddress $ E.encodeUtf8 txt
-- | Copy an address to the clipboard
copyAddress :: ZcashAddress -> IO ()
copyAddress a =
void $
createProcess_ "toClipboard" $
shell $ "echo " ++ T.unpack (addy a) ++ " | xclip -r -selection clipboard"

343
src/Zenith/Zcashd.hs Normal file
View File

@ -0,0 +1,343 @@
{-# LANGUAGE OverloadedStrings #-}
module Zenith.Zcashd where
import Control.Concurrent (threadDelay)
import Control.Monad (when)
import Data.Aeson
import qualified Data.Array as A
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Char8 as C
import qualified Data.ByteString.Lazy as LBS
import Data.Maybe
import qualified Data.Scientific as Scientific
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import Data.Text.Encoding.Error (lenientDecode)
import qualified Data.Text.IO as TIO
import qualified Data.Vector as V
import Network.HTTP.Simple
import System.Clipboard
import System.Exit
import System.IO
import Text.Read (readMaybe)
import Text.Regex
import Text.Regex.Base
import ZcashHaskell.Types (RpcCall(..), RpcResponse(..))
import Zenith.Types
( AddressGroup
, AddressSource(..)
, NodeVersion(..)
, OpResult(..)
, UABalance(..)
, ZcashAddress(..)
, ZcashPool(..)
, ZcashTx
, encodeHexText'
)
import Zenith.Utils (displayZec, getAddresses, validateAddress)
-- * RPC methods
-- | List addresses
listAddresses :: BS.ByteString -> BS.ByteString -> IO [ZcashAddress]
listAddresses user pwd = do
response <- makeZcashCall user pwd "listaddresses" []
let rpcResp = decode response :: Maybe (RpcResponse [AddressGroup])
case rpcResp of
Nothing -> fail "Couldn't parse node response"
Just res -> do
let addys = result res
case addys of
Nothing -> fail "Empty response"
Just addys' -> do
let addList = concatMap getAddresses addys'
return addList
-- | Get address balance
getBalance :: BS.ByteString -> BS.ByteString -> ZcashAddress -> IO [Integer]
getBalance user pwd zadd = do
let a = account zadd
case a of
Nothing -> do
response <-
makeZcashCall
user
pwd
"z_getbalance"
[ String (addy zadd)
, Number (Scientific.scientific 1 0)
, Data.Aeson.Bool True
]
let rpcResp = decode response :: Maybe (RpcResponse Integer)
case rpcResp of
Nothing -> fail "Couldn't parse node response"
Just res -> do
case result res of
Nothing -> return []
Just r -> return [r]
Just acct -> do
response <-
makeZcashCall
user
pwd
"z_getbalanceforaccount"
[Number (Scientific.scientific acct 0)]
let rpcResp = decode response :: Maybe (RpcResponse UABalance)
case rpcResp of
Nothing -> fail "Couldn't parse node response"
Just res -> do
case result res of
Nothing -> return [0, 0, 0]
Just r -> return $ readUABalance r
where readUABalance ua =
[uatransparent ua, uasapling ua, uaorchard ua]
-- | List transactions
listTxs :: BS.ByteString -> BS.ByteString -> ZcashAddress -> IO [ZcashTx]
listTxs user pwd zaddy = do
response <-
makeZcashCall user pwd "z_listreceivedbyaddress" [String $ addy zaddy]
let rpcResp = decode response :: Maybe (RpcResponse [ZcashTx])
case rpcResp of
Nothing -> fail "listTxs: Couldn't parse node response"
Just res -> do
case result res of
Nothing -> fail "listTxs: Empty response"
Just res' -> return res'
-- | Send Tx
sendTx ::
BS.ByteString
-> BS.ByteString
-> ZcashAddress
-> T.Text
-> Double
-> Maybe T.Text
-> IO ()
sendTx user pwd fromAddy toAddy amount memo = do
bal <- getBalance user pwd fromAddy
let valAdd = validateAddress toAddy
if sum bal - floor (amount * 100000000) >= 1000
then do
if source fromAddy /= ImportedWatchOnly
then do
let privacyPolicy
| valAdd == Just Transparent = "AllowRevealedRecipients"
| isNothing (account fromAddy) &&
elem Transparent (pool fromAddy) = "AllowRevealedSenders"
| otherwise = "AllowRevealedAmounts"
let pd =
case memo of
Nothing ->
[ Data.Aeson.String (addy fromAddy)
, Data.Aeson.Array
(V.fromList
[object ["address" .= toAddy, "amount" .= amount]])
, Data.Aeson.Number $ Scientific.scientific 1 1
, Data.Aeson.Null
, Data.Aeson.String privacyPolicy
]
Just memo' ->
[ Data.Aeson.String (addy fromAddy)
, Data.Aeson.Array
(V.fromList
[ object
[ "address" .= toAddy
, "amount" .= amount
, "memo" .= encodeHexText' memo'
]
])
, Data.Aeson.Number $ Scientific.scientific 1 1
, Data.Aeson.Null
, Data.Aeson.String privacyPolicy
]
response <- makeZcashCall user pwd "z_sendmany" pd
let rpcResp = decode response :: Maybe (RpcResponse T.Text)
case rpcResp of
Nothing -> fail "Couldn't parse node response"
Just res -> do
putStr " Sending."
checkOpResult user pwd (fromMaybe "" $ result res)
else putStrLn "Error: Source address is view-only."
else putStrLn "Error: Insufficient balance in source address."
-- | Check Zcash full node server
checkServer :: BS.ByteString -> BS.ByteString -> IO ()
checkServer user pwd = do
resp <- makeZcashCall user pwd "getinfo" []
let rpcResp = decode resp :: Maybe (RpcResponse NodeVersion)
case rpcResp of
Nothing -> fail "Couldn't parse node response"
Just myResp -> do
let r = result myResp
case r of
Nothing -> fail "Empty node response"
Just r' -> do
if isNodeValid r'
then putStrLn $ "Connected to Zcash Full Node (" <> show r <> ") :)"
else do
putStrLn "Deprecated Zcash Full Node version found. Exiting"
exitFailure
where isNodeValid (NodeVersion i) = i >= 5000000
-- | Check for accounts
checkAccounts :: BS.ByteString -> BS.ByteString -> IO Bool
checkAccounts user pwd = do
response <- makeZcashCall user pwd "z_listaccounts" []
let rpcResp = decode response :: Maybe (RpcResponse [Object])
case rpcResp of
Nothing -> fail "Couldn't parse node response"
Just res -> do
let r = result res
return $ not (null r)
-- | Add account to node
createAccount :: BS.ByteString -> BS.ByteString -> IO ()
createAccount user pwd = do
response <- makeZcashCall user pwd "z_getnewaccount" []
let rpcResp = decode response :: Maybe (RpcResponse Object)
case rpcResp of
Nothing -> fail "Couldn't parse node response"
Just res -> do
let r = result res
putStrLn " Account created!"
-- | Create new Unified Address
createUnifiedAddress :: BS.ByteString -> BS.ByteString -> Bool -> Bool -> IO ()
createUnifiedAddress user pwd tRec sRec = do
let recs = getReceivers tRec sRec
let pd = [Data.Aeson.Number $ Scientific.scientific 0 1, recs]
newResp <- makeZcashCall user pwd "z_getaddressforaccount" pd
let rpcResp = decode newResp :: Maybe (RpcResponse Object)
case rpcResp of
Nothing -> fail "Couldn't parse node response"
Just res -> do
let r = result res
putStrLn " New UA created!"
where
getReceivers t s
| t && s =
Data.Aeson.Array
(V.fromList
[ Data.Aeson.String "p2pkh"
, Data.Aeson.String "sapling"
, Data.Aeson.String "orchard"
])
| t =
Data.Aeson.Array
(V.fromList [Data.Aeson.String "p2pkh", Data.Aeson.String "orchard"])
| s =
Data.Aeson.Array
(V.fromList [Data.Aeson.String "sapling", Data.Aeson.String "orchard"])
| otherwise = Data.Aeson.Array (V.fromList [Data.Aeson.String "orchard"])
-- | Verify operation result
checkOpResult :: BS.ByteString -> BS.ByteString -> T.Text -> IO ()
checkOpResult user pwd opid = do
response <-
makeZcashCall
user
pwd
"z_getoperationstatus"
[Data.Aeson.Array (V.fromList [Data.Aeson.String opid])]
let rpcResp = decode response :: Maybe (RpcResponse [OpResult])
case rpcResp of
Nothing -> fail "Couldn't parse node response"
Just res -> do
let r = result res
case r of
Nothing -> fail "Empty node response"
Just r' -> mapM_ showResult r'
where
showResult t =
case opsuccess t of
"success" ->
putStrLn $ " Success! Tx ID: " ++ maybe "" T.unpack (optxid t)
"executing" -> do
putStr "."
hFlush stdout
threadDelay 1000000 >> checkOpResult user pwd opid
_ -> putStrLn $ " Failed :( " ++ maybe "" T.unpack (opmessage t)
-- | Make a Zcash RPC call
makeZcashCall ::
BS.ByteString
-> BS.ByteString
-> T.Text
-> [Data.Aeson.Value]
-> IO LBS.ByteString
makeZcashCall username password m p = do
let payload = RpcCall "1.0" "test" m p
let myRequest =
setRequestBodyJSON payload $
setRequestPort 8232 $
setRequestBasicAuth username password $
setRequestMethod "POST" defaultRequest
response <- httpLBS myRequest
let respStatus = getResponseStatusCode response
let body = getResponseBody response
case respStatus of
500 -> do
let rpcResp = decode body :: Maybe (RpcResponse String)
case rpcResp of
Nothing -> fail $ "Unknown server error " ++ show response
Just x -> fail (fromMaybe "" $ result x)
401 -> fail "Incorrect full node credentials"
200 -> return body
_ -> fail "Unknown error"
-- | Read ZIP-321 URI
sendWithUri ::
BS.ByteString -> BS.ByteString -> ZcashAddress -> String -> Bool -> IO ()
sendWithUri user pwd fromAddy uri repTo = do
let uriRegex = mkRegex "^zcash:(\\w+)\\?amount=(.*)\\&memo=(.*)$"
if matchTest uriRegex uri
then do
let reg = matchAllText uriRegex uri
let parsedAddress = fst $ head reg A.! 1
let parsedAmount = fst $ head reg A.! 2
let parsedEncodedMemo = fst $ head reg A.! 3
let addType = validateAddress $ T.pack parsedAddress
case addType of
Nothing -> putStrLn " Invalid address"
Just Transparent -> do
putStrLn $ " Address is valid: " ++ parsedAddress
case (readMaybe parsedAmount :: Maybe Double) of
Nothing -> putStrLn " Invalid amount."
Just amt -> do
putStrLn $ " Valid ZEC amount: " ++ show amt
sendTx user pwd fromAddy (T.pack parsedAddress) amt Nothing
Just _ -> do
putStrLn $ " Address is valid: " ++ parsedAddress
case (readMaybe parsedAmount :: Maybe Double) of
Nothing -> putStrLn " Invalid amount."
Just amt -> do
putStrLn $ " Valid ZEC amount: " ++ show amt
let decodedMemo =
E.decodeUtf8With lenientDecode $
B64.decodeLenient $ C.pack parsedEncodedMemo
TIO.putStrLn $ " Memo: " <> decodedMemo
sendTx
user
pwd
fromAddy
(T.pack parsedAddress)
amt
(if repTo
then Just $
T.concat [decodedMemo, "\nReply-To:\n", addy fromAddy]
else Just decodedMemo)
else putStrLn "URI is not compliant with ZIP-321"
-- | Display an address
displayZcashAddress ::
BS.ByteString -> BS.ByteString -> (Int, ZcashAddress) -> IO ()
displayZcashAddress user pwd (idx, zaddy) = do
zats <- getBalance user pwd zaddy
putStr $ show idx ++ ": "
putStr $ show zaddy
when (source zaddy == ImportedWatchOnly) (putStr "[VK]")
putStr " Balance: "
mapM_ (putStr . displayZec) zats
putStrLn ""

View File

@ -1,81 +0,0 @@
# This file was automatically generated by 'stack init'
#
# Some commonly used options have been documented as comments in this file.
# For advanced use and comprehensive documentation of the format, please see:
# https://docs.haskellstack.org/en/stable/yaml_configuration/
# Resolver to choose a 'specific' stackage snapshot or a compiler version.
# A snapshot resolver dictates the compiler version and the set of packages
# to be used for project dependencies. For example:
#
# resolver: lts-3.5
# resolver: nightly-2015-09-21
# resolver: ghc-7.10.2
#
# The location of a snapshot can be provided as a file or url. Stack assumes
# a snapshot provided as a file might change, whereas a url resource does not.
#
# resolver: ./custom-snapshot.yaml
# resolver: https://example.com/snapshots/2018-01-01.yaml
resolver: lts-21.6
# User packages to be built.
# Various formats can be used as shown in the example below.
#
# packages:
# - some-directory
# - https://example.com/foo/bar/baz-0.0.2.tar.gz
# subdirs:
# - auto-update
# - wai
packages:
- .
#- haskoin-core
#- zcash-haskell
# Dependency packages to be pulled from upstream that are not in the resolver.
# These entries can reference officially published versions as well as
# forks / in-progress versions pinned to a git hash. For example:
#
# extra-deps:
# - acme-missiles-0.3
# - git: https://github.com/commercialhaskell/stack.git
# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
#
# extra-deps: []
extra-deps:
- git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
commit: fef3d3af35a09db718cddb8fc9166b2d2691a744
- git: https://git.vergara.tech/Vergara_Tech/haskell-foreign-rust.git
commit: 787c2e813eb3a5d16c375d4b37dfefbd2adcdf05
- git: https://github.com/reach-sh/haskell-hexstring.git
commit: 085c16fb21b9f856a435a3faab980e7e0b319341
- git: https://github.com/well-typed/borsh.git
commit: d2fcfa159e0a844b1ec5e8ed3e232d4b380fa831
- vector-0.13.0.0@sha256:fa5cac81a17a5af388716792e8b99c24b3b66770086756d0d8b23f8272a0244c,9112
- generically-0.1.1
- vector-algorithms-0.9.0.1
#- vector-0.12.3.1@sha256:abbfe8830e13549596e1295219d340eb01bd00e1c7124d0dd16586911a291c59,8218
#extra-lib-dirs: [/home/rav/Documents/programs/haskoin]
#
# Override default flag values for local packages and extra-deps
# flags: {}
# Extra package databases containing global packages
# extra-package-dbs: []
# Control whether we use the GHC we find on the path
# system-ghc: true
#
# Require a specific version of stack, using version ranges
# require-stack-version: -any # Default
# require-stack-version: ">=2.7"
#
# Override the architecture used by stack, especially useful on Windows
# arch: i386
# arch: x86_64
#
# Extra directories used by stack for building
# extra-include-dirs: [/path/to/dir]
#
# Allow a newer minor version of GHC than the snapshot specifies
# compiler-check: newer-minor

View File

@ -1,77 +0,0 @@
# This file was autogenerated by Stack.
# You should not edit this file by hand.
# For more information, please see the documentation at:
# https://docs.haskellstack.org/en/stable/lock_files
packages:
- completed:
commit: fef3d3af35a09db718cddb8fc9166b2d2691a744
git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
name: zcash-haskell
pantry-tree:
sha256: ec7782cf2646da17548d59af0ea98dcbaac1b6c2176258c696a7f508db6dbc21
size: 1126
version: 0.1.0
original:
commit: fef3d3af35a09db718cddb8fc9166b2d2691a744
git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
- completed:
commit: 787c2e813eb3a5d16c375d4b37dfefbd2adcdf05
git: https://git.vergara.tech/Vergara_Tech/haskell-foreign-rust.git
name: foreign-rust
pantry-tree:
sha256: be2f6fc0fab58a90fec657bdb6bd0ccf0810c7dccfe95c78b85e174fae227e42
size: 2315
version: 0.1.0
original:
commit: 787c2e813eb3a5d16c375d4b37dfefbd2adcdf05
git: https://git.vergara.tech/Vergara_Tech/haskell-foreign-rust.git
- completed:
commit: 085c16fb21b9f856a435a3faab980e7e0b319341
git: https://github.com/reach-sh/haskell-hexstring.git
name: hexstring
pantry-tree:
sha256: 9ecf67856f59dfb382b283eceb42e4fc1865935d1a7e59111556ed381c6a2ffd
size: 687
version: 0.11.1
original:
commit: 085c16fb21b9f856a435a3faab980e7e0b319341
git: https://github.com/reach-sh/haskell-hexstring.git
- completed:
commit: d2fcfa159e0a844b1ec5e8ed3e232d4b380fa831
git: https://github.com/well-typed/borsh.git
name: borsh
pantry-tree:
sha256: 8335925f495a5a653fcb74b6b8bb18cd0b6b7fe7099a1686108704e6ab82f47b
size: 2268
version: 0.3.0
original:
commit: d2fcfa159e0a844b1ec5e8ed3e232d4b380fa831
git: https://github.com/well-typed/borsh.git
- completed:
hackage: vector-0.13.0.0@sha256:fa5cac81a17a5af388716792e8b99c24b3b66770086756d0d8b23f8272a0244c,9112
pantry-tree:
sha256: d2461d28022c8c0a91da08b579b1bff478f617102d2f5ef596cc5b28d14b8b6a
size: 4092
original:
hackage: vector-0.13.0.0@sha256:fa5cac81a17a5af388716792e8b99c24b3b66770086756d0d8b23f8272a0244c,9112
- completed:
hackage: generically-0.1.1@sha256:aa00d9a77b7fb90c08f935699758ed9de55975021b1e979c6a4a4b5b49a940a9,1133
pantry-tree:
sha256: ec19e6d2aecfbe7a59e789526b9d7ab5c8ba853f017248d0203ee69a9769adb7
size: 233
original:
hackage: generically-0.1.1
- completed:
hackage: vector-algorithms-0.9.0.1@sha256:f3e5c6695529a94edf762117cafd91c989cb642ad3f8ca4014dbb13c8f6c2a20,3826
pantry-tree:
sha256: aef389e57ae6020e5da719bee40aaf6cccf1c4d1e7743a85d30c9d8c25d170a0
size: 1510
original:
hackage: vector-algorithms-0.9.0.1
snapshots:
- completed:
sha256: 2e7d4a730d8eb5373b2d383fac84efcf7c81e3b7a5fce71b4c2e19a1768f25a6
size: 640239
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/21/6.yaml
original: lts-21.6

View File

@ -1,2 +1,253 @@
{-# LANGUAGE OverloadedStrings #-}
import Control.Monad (when)
import Control.Monad.Logger (runNoLoggingT)
import Data.HexString
import qualified Data.Text.Encoding as E
import Database.Persist
import Database.Persist.Sqlite
import System.Directory
import Test.HUnit
import Test.Hspec
import ZcashHaskell.Orchard (isValidUnifiedAddress)
import ZcashHaskell.Sapling
( decodeSaplingOutputEsk
, encodeSaplingAddress
, getSaplingNotePosition
, getSaplingWitness
, isValidShieldedAddress
, updateSaplingCommitmentTree
)
import ZcashHaskell.Transparent
( decodeExchangeAddress
, decodeTransparentAddress
)
import ZcashHaskell.Types
( DecodedNote(..)
, OrchardSpendingKey(..)
, Phrase(..)
, SaplingCommitmentTree(..)
, SaplingReceiver(..)
, SaplingSpendingKey(..)
, Scope(..)
, ShieldedOutput(..)
, ZcashNet(..)
)
import Zenith.Core
import Zenith.DB
import Zenith.Types
main :: IO ()
main = putStrLn "Test suite not yet implemented"
main = do
checkDbFile <- doesFileExist "test.db"
when checkDbFile $ removeFile "test.db"
hspec $ do
describe "Database tests" $ do
it "Create table" $ do
s <- runSqlite "test.db" $ do runMigration migrateAll
s `shouldBe` ()
describe "Wallet Table" $ do
it "insert wallet record" $ do
s <-
runSqlite "test.db" $ do
insert $
ZcashWallet
"Main Wallet"
(ZcashNetDB MainNet)
(PhraseDB $
Phrase
"one two three four five six seven eight nine ten eleven twelve")
2000000
0
fromSqlKey s `shouldBe` 1
it "read wallet record" $ do
s <-
runSqlite "test.db" $ do
selectList [ZcashWalletBirthdayHeight >. 0] []
length s `shouldBe` 1
it "modify wallet record" $ do
s <-
runSqlite "test.db" $ do
let recId = toSqlKey 1 :: ZcashWalletId
update recId [ZcashWalletName =. "New Wallet"]
get recId
"New Wallet" `shouldBe` maybe "None" zcashWalletName s
it "delete wallet record" $ do
s <-
runSqlite "test.db" $ do
let recId = toSqlKey 1 :: ZcashWalletId
delete recId
get recId
"None" `shouldBe` maybe "None" zcashWalletName s
describe "Wallet function tests:" $ do
it "Save Wallet:" $ do
pool <- runNoLoggingT $ initPool "test.db"
zw <-
saveWallet pool $
ZcashWallet
"Testing"
(ZcashNetDB MainNet)
(PhraseDB $
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")
2200000
0
zw `shouldNotBe` Nothing
it "Save Account:" $ do
pool <- runNoLoggingT $ initPool "test.db"
s <-
runSqlite "test.db" $ do
selectList [ZcashWalletName ==. "Testing"] []
za <- saveAccount pool =<< createZcashAccount "TestAccount" 0 (head s)
za `shouldNotBe` Nothing
it "Save address:" $ do
pool <- runNoLoggingT $ initPool "test.db"
acList <-
runSqlite "test.db" $
selectList [ZcashAccountName ==. "TestAccount"] []
zAdd <-
saveAddress pool =<<
createWalletAddress "Personal123" 0 MainNet External (head acList)
addList <-
runSqlite "test.db" $
selectList
[ WalletAddressName ==. "Personal123"
, WalletAddressScope ==. ScopeDB External
]
[]
getUA (walletAddressUAddress (entityVal $ head addList)) `shouldBe`
"u1trd8cvc6265ywwj4mmvuznsye5ghe2dhhn3zy8kcuyg4vx3svskw9r2dedp5hu6m740vylkqc34t4w9eqkl9fyu5uyzn3af72jg235440ke6tu5cf994eq85n97x69x9824hqejmwz3d8qqthtesrd6gerjupdymldhl9xccejjwfj0dhh9mt4rw4kytp325twlutsxd20rfqhzxu3m"
it "Address components are correct" $ do
let ua =
"utest1mvlny48qd4x94w8vz5u2lrxx0enuquajt72yekgq24p6pjaky3czk6m7x358h7g900ex6gzvdehaekl96qnakjzw8yaasp8y0u3j5jnlfd33trduznh6k3fcn5ek9qc857fgz8ehm37etx94sj58nrkc0k5hurxnuxpcpms3j8uy2t8kt2vy6vetvsfxxdhtjq0yqulqprvh7mf2u3x"
isValidUnifiedAddress ua `shouldNotBe` Nothing
describe "Function tests" $ do
describe "Sapling Decoding" $ do
let sk =
SaplingSpendingKey
"\ETX}\195.\SUB\NUL\NUL\NUL\128\NUL\203\"\229IL\CANJ*\209\EM\145\228m\172\&4\SYNNl\DC3\161\147\SO\157\238H\192\147eQ\143L\201\216\163\180\147\145\156Zs+\146>8\176`ta\161\223\SO\140\177\b;\161\SO\236\151W\148<\STX\171|\DC2\172U\195(I\140\146\214\182\137\211\228\159\128~bV\STXy{m'\224\175\221\219\180!\ENQ_\161\132\240?\255\236\"6\133\181\170t\181\139\143\207\170\211\ENQ\167a\184\163\243\246\140\158t\155\133\138X\a\241\200\140\EMT\GS~\175\249&z\250\214\231\239mi\223\206\STX\t\EM<{V~J\253FB"
let tree =
SaplingCommitmentTree $
hexString
"01818f2bd58b1e392334d0565181cc7843ae09e3533b2a50a8f1131af657340a5c001001161f962245812ba5e1804fd0a336bc78fa4ee4441a8e0f1525ca5da1b285d35101120f45afa700b8c1854aa8b9c8fe8ed92118ef790584bfcb926078812a10c83a00000000012f4f72c03f8c937a94919a01a07f21165cc8394295291cb888ca91ed003810390107114fe4bb4cd08b47f6ae47477c182d5da9fe5c189061808c1091e9bf3b4524000001447d6b9100cddd5f80c8cf4ddee2b87eba053bd987465aec2293bd0514e68b0d015f6c95e75f4601a0a31670a7deb970fc8988c611685161d2e1629d0a1a0ebd07015f8b9205e0514fa235d75c150b87e23866b882b39786852d1ab42aab11d31a4a0117ddeb3a5f8d2f6b2d0a07f28f01ab25e03a05a9319275bb86d72fcaef6fc01501f08f39275112dd8905b854170b7f247cf2df18454d4fa94e6e4f9320cca05f24011f8322ef806eb2430dc4a7a41c1b344bea5be946efc7b4349c1c9edb14ff9d39"
let nextTree =
SaplingCommitmentTree $
hexString
"01bd8a3f3cfc964332a2ada8c09a0da9dfc24174befb938abb086b9be5ca049e4900100000019f0d7efb00169bb2202152d3266059d208ab17d14642c3339f9075e997160657000000012f4f72c03f8c937a94919a01a07f21165cc8394295291cb888ca91ed003810390107114fe4bb4cd08b47f6ae47477c182d5da9fe5c189061808c1091e9bf3b4524000001447d6b9100cddd5f80c8cf4ddee2b87eba053bd987465aec2293bd0514e68b0d015f6c95e75f4601a0a31670a7deb970fc8988c611685161d2e1629d0a1a0ebd07015f8b9205e0514fa235d75c150b87e23866b882b39786852d1ab42aab11d31a4a0117ddeb3a5f8d2f6b2d0a07f28f01ab25e03a05a9319275bb86d72fcaef6fc01501f08f39275112dd8905b854170b7f247cf2df18454d4fa94e6e4f9320cca05f24011f8322ef806eb2430dc4a7a41c1b344bea5be946efc7b4349c1c9edb14ff9d39"
it "Sapling is decoded correctly" $ do
so <-
runSqlite "zenith.db" $
selectList [ShieldOutputTx ==. toSqlKey 38318] []
let cmus = map (getHex . shieldOutputCmu . entityVal) so
let pos =
getSaplingNotePosition <$>
(getSaplingWitness =<<
updateSaplingCommitmentTree tree (head cmus))
let pos1 = getSaplingNotePosition <$> getSaplingWitness tree
let pos2 = getSaplingNotePosition <$> getSaplingWitness nextTree
case pos of
Nothing -> assertFailure "couldn't get note position"
Just p -> do
print p
print pos1
print pos2
let dn =
decodeSaplingOutputEsk
sk
(ShieldedOutput
(getHex $ shieldOutputCv $ entityVal $ head so)
(getHex $ shieldOutputCmu $ entityVal $ head so)
(getHex $ shieldOutputEphKey $ entityVal $ head so)
(getHex $ shieldOutputEncCipher $ entityVal $ head so)
(getHex $ shieldOutputOutCipher $ entityVal $ head so)
(getHex $ shieldOutputProof $ entityVal $ head so))
TestNet
External
p
case dn of
Nothing -> assertFailure "couldn't decode Sap output"
Just d ->
a_nullifier d `shouldBe`
hexString
"6c5d1413c63a9a88db71c3f41dc12cd60197ee742fc75b217215e7144db48bd3"
describe "Note selection for Tx" $ do
it "Value less than balance" $ do
pool <- runNoLoggingT $ initPool "zenith.db"
res <- selectUnspentNotes pool (toSqlKey 1) 14000000
res `shouldNotBe` ([], [], [])
it "Value greater than balance" $ do
pool <- runNoLoggingT $ initPool "zenith.db"
let res = selectUnspentNotes pool (toSqlKey 1) 84000000
res `shouldThrow` anyIOException
it "Fee calculation" $ do
pool <- runNoLoggingT $ initPool "zenith.db"
res <- selectUnspentNotes pool (toSqlKey 1) 14000000
calculateTxFee res 3 `shouldBe` 20000
describe "Testing validation" $ do
it "Unified" $ do
let a =
"utest1zfnw84xuxg0ytzqc008gz0qntr8cvwu4qjsccgtxwdrjywra7uj85x8ldymjc2jd3jvvvhyj3xwsunyvwkr5084t6p5gmvzwdgvwpflrpd6a3squ2dp8vt7cxngmwk30l44wkmvyfegypqmezxfnqj572lr779gkqj5xekp66uv4jga58alnc5j7tuank758zd96ap4f09udg6y6pxu"
True `shouldBe`
(case isValidUnifiedAddress (E.encodeUtf8 a) of
Just _a1 -> True
Nothing ->
isValidShieldedAddress (E.encodeUtf8 a) ||
(case decodeTransparentAddress (E.encodeUtf8 a) of
Just _a3 -> True
Nothing ->
case decodeExchangeAddress a of
Just _a4 -> True
Nothing -> False))
it "Sapling" $ do
let a =
"ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4"
True `shouldBe`
(case isValidUnifiedAddress (E.encodeUtf8 a) of
Just _a1 -> True
Nothing ->
isValidShieldedAddress (E.encodeUtf8 a) ||
(case decodeTransparentAddress (E.encodeUtf8 a) of
Just _a3 -> True
Nothing ->
case decodeExchangeAddress a of
Just _a4 -> True
Nothing -> False))
it "Transparent" $ do
let a = "tmGfVZHuGVJ5vcLAgBdkUU4w7fLTRE5nXm3"
True `shouldBe`
(case isValidUnifiedAddress (E.encodeUtf8 a) of
Just _a1 -> True
Nothing ->
isValidShieldedAddress (E.encodeUtf8 a) ||
(case decodeTransparentAddress (E.encodeUtf8 a) of
Just _a3 -> True
Nothing ->
case decodeExchangeAddress a of
Just _a4 -> True
Nothing -> False))
it "Check Sapling Address" $ do
let a =
encodeSaplingAddress TestNet $
SaplingReceiver
"Z$:\136!u\171<\156\196\210\SUB\n\137Hp<\221\166\146\SOH\196\172,3<\255\181\195/\239\170\158\208O\217\197\DC3\197\ESC\n\NUL-"
a `shouldBe`
Just
"ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4"
{-describe "Creating Tx" $ do-}
{-xit "To Orchard" $ do-}
{-let uaRead =-}
{-isValidUnifiedAddress-}
{-"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"-}
{-case uaRead of-}
{-Nothing -> assertFailure "wrong address"-}
{-Just ua -> do-}
{-tx <--}
{-prepareTx-}
{-"zenith.db"-}
{-TestNet-}
{-(toSqlKey 1)-}
{-2819811-}
{-0.04-}
{-ua-}
{-"sent with Zenith, test"-}
{-tx `shouldBe` Right (hexString "deadbeef")-}

1
zcash-haskell Submodule

@ -0,0 +1 @@
Subproject commit 90c8a7c3028bd6836dea5655221277a25d457653

1007
zebra_openapi.yaml Normal file

File diff suppressed because it is too large Load Diff

View File

@ -1,65 +1,93 @@
cabal-version: 1.12
cabal-version: 3.0
name: zenith
version: 0.5.2.0-beta
license: MIT
license-file: LICENSE
author: Rene Vergara
maintainer: pitmutt@vergara.tech
copyright: (c) 2022-2024 Vergara Technologies LLC
build-type: Custom
category: Blockchain
extra-doc-files:
README.md
CHANGELOG.md
zenith.cfg
-- This file has been generated from package.yaml by hpack version 0.35.1.
--
-- see: https://github.com/sol/hpack
name: zenith
version: 0.4.0
synopsis: Haskell CLI for Zcash Full Node
description: Please see the README on repo at <https://git.vergara.tech/Vergara_Tech/zenith#readme>
author: Rene Vergara
maintainer: rene@vergara.network
copyright: Copyright (c) 2022 Vergara Technologies LLC
license: BOSL
license-file: LICENSE
build-type: Simple
extra-source-files:
README.md
CHANGELOG.md
zenith.cfg
source-repository head
type: git
location: https://git.vergara.tech/Vergara_Tech/zenith
custom-setup
setup-depends:
base >= 4.12 && < 5
, Cabal >= 3.2.0.0
, directory >= 1.3.6.0
, filepath >= 1.3.0.2
, regex-base
, regex-compat
library
ghc-options: -Wall -Wunused-imports
exposed-modules:
Zenith
other-modules:
Paths_zenith
Zenith.CLI
Zenith.Core
Zenith.DB
Zenith.Types
Zenith.Utils
Zenith.Zcashd
Zenith.Scanner
hs-source-dirs:
src
src
build-depends:
Clipboard
, aeson
, array
, base >=4.7 && <5
, ascii-progress
, base >=4.12 && <5
, base64-bytestring
, blake2
, brick
, bytestring
, esqueleto
, resource-pool
, binary
, exceptions
, monad-logger
, vty-crossplatform
, secp256k1-haskell
, pureMD5
, ghc
, haskoin-core
, hexstring
, http-client
, http-conduit
, http-types
, microlens
, microlens-mtl
, microlens-th
, mtl
, persistent
, Hclip
, persistent-sqlite
, persistent-template
, process
, regex-base
, regex-compat
, regex-posix
, scientific
, text
, time
, vector
, vty
, word-wrap
, zcash-haskell
--pkgconfig-depends: rustzcash_wrapper
default-language: Haskell2010
executable zenith
ghc-options: -threaded -rtsopts -with-rtsopts=-N
main-is: Main.hs
other-modules:
Paths_zenith
hs-source-dirs:
app
ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -Wunused-imports
app
build-depends:
base >=4.7 && <5
base >=4.12 && <5
, brick
, bytestring
, configurator
, data-default
@ -68,17 +96,45 @@ executable zenith
, text
, time
, zenith
, zcash-haskell
pkgconfig-depends: rustzcash_wrapper
default-language: Haskell2010
test-suite zenith-test
type: exitcode-stdio-1.0
main-is: Spec.hs
other-modules:
Paths_zenith
executable zenscan
ghc-options: -main-is ZenScan -threaded -rtsopts -with-rtsopts=-N
main-is: ZenScan.hs
hs-source-dirs:
test
ghc-options: -threaded -rtsopts -with-rtsopts=-N
app
build-depends:
base >=4.7 && <5
base >=4.12 && <5
, configurator
, monad-logger
, zenith
pkgconfig-depends: rustzcash_wrapper
default-language: Haskell2010
test-suite zenith-tests
type: exitcode-stdio-1.0
ghc-options: -threaded -rtsopts -with-rtsopts=-N
main-is: Spec.hs
hs-source-dirs:
test
build-depends:
base >=4.12 && <5
, bytestring
, configurator
, monad-logger
, data-default
, sort
, text
, time
, persistent
, persistent-sqlite
, hspec
, hexstring
, HUnit
, directory
, zcash-haskell
, zenith
pkgconfig-depends: rustzcash_wrapper
default-language: Haskell2010

View File

@ -1,2 +1,5 @@
nodeUser = "user"
nodePwd = "superSecret"
dbFilePath = "zenith.db"
zebraHost = "127.0.0.1"
zebraPort = 18232