Compare commits

...

107 Commits

Author SHA1 Message Date
pitmutt 87bab38720
Merge pull request 'dev181: Update to license and libraries' (#9) from dev181 into master
Reviewed-on: #9
2024-01-29 20:25:39 +00:00
Rene Vergara ab6cc7f413
Update version 2024-01-29 14:22:51 -06:00
Rene Vergara eaa11afa70
Update to latest version of `zcash-haskell` 2024-01-29 14:21:59 -06:00
pitmutt 5ab5f9fb91
Merge pull request 'Unified Address support' (#8) from dev18 into master
Reviewed-on: #8
2023-10-28 12:24:27 +00:00
Rene Vergara 5d9d261eb9
Version update 2023-10-28 07:20:18 -05:00
Rene Vergara b670a1c15f
Fix tax calculationj 2023-10-25 16:25:27 -05:00
Rene Vergara 9bd94843b4
Add tax calculations 2023-10-25 16:16:42 -05:00
Rene Vergara a20271db6d
Create utility to load updated languages 2023-10-23 13:43:45 -05:00
Rene Vergara 9c44d0443e
Add tax and tip fields to order 2023-10-20 15:32:14 -05:00
Rene Vergara 50925970fc
Correct order Id handling 2023-10-20 14:52:09 -05:00
Rene Vergara 0c77163f31
Correct order upserting 2023-10-20 13:32:29 -05:00
Rene Vergara bd32d6c149
Add tips to database saving action 2023-10-20 08:09:08 -05:00
Rene Vergara 7daa9a9687
Add tip setting to owners 2023-10-19 14:47:57 -05:00
Rene Vergara 1c3dfd2da1
Remove unused orderx endpoint 2023-10-17 14:56:16 -05:00
Rene Vergara a338c65892
Merge branch 'fix0063' into dev18 2023-10-16 14:59:05 -05:00
Rene Vergara 2b2c3ba70e
Update order endpoint for improved security 2023-10-16 14:58:33 -05:00
Rene Vergara 056ddff816
Merge branch 'fix015' into dev18
Included the new native scan of transactions using viewing keys
2023-10-15 08:03:26 -05:00
Rene Vergara ac86d1ee59
Correct block recording 2023-10-13 15:35:48 -05:00
Rene Vergara 5788a26880
Enable new native transaction scanning 2023-10-13 15:20:01 -05:00
Rene Vergara ec72015524
Correct ZEC calculation 2023-10-13 15:06:08 -05:00
Rene Vergara 19b352c381
Continue debugging 2023-10-13 14:59:14 -05:00
Rene Vergara 4558dfb8da
Add more debugging 2023-10-13 14:53:33 -05:00
Rene Vergara a3eb5d29ee
Add debugging 2023-10-13 14:45:19 -05:00
Rene Vergara c2be91dfcc
Add ZGo order parsing and payment tracking 2023-10-13 14:20:10 -05:00
Rene Vergara d7ced42d86
Implement saving of scanned txs 2023-10-12 14:53:53 -05:00
Rene Vergara ccd9e8280e
Tests for adding UVK 2023-10-11 14:25:01 -05:00
Rene Vergara b14a5cfb83
Improve messaging for PIN send 2023-10-11 07:51:16 -05:00
Rene Vergara f5dbde0ed6
Improve PIN send 2023-10-10 11:12:58 -05:00
Rene Vergara a2654a6f01
Correct the Sapling vk call 2023-10-09 16:28:17 -05:00
Rene Vergara cd5af6b907
Add UFVK support for ZGo shops 2023-10-04 14:10:13 -05:00
Rene Vergara 68285fbc39
Update to next `zcash_haskell` version 2023-10-04 14:09:49 -05:00
Rene Vergara 3f3cb9ef7c
Remove call to `zcashd` to validate VK 2023-10-04 11:19:11 -05:00
Rene Vergara 493d17abfd
Improve decoding of Txs 2023-10-03 11:07:01 -05:00
Rene Vergara bf740857b3
Modify tx scanner to generate ZcashTx 2023-10-03 10:47:54 -05:00
Rene Vergara cd259f244a
Update version of `zcash-haskell` 2023-10-02 15:27:59 -05:00
Rene Vergara d235c56cfb
Correct tx filtering 2023-09-29 14:33:17 -05:00
Rene Vergara 74ba9d23f0
Update to next version of `zcash-haskell` 2023-09-29 14:15:17 -05:00
Rene Vergara 0224db1993
Implement Sapling decoding 2023-09-29 13:49:34 -05:00
Rene Vergara 3ed60ae2dd
Update version of `zcash-haskell` 2023-09-29 13:30:14 -05:00
Rene Vergara af22c0d71f
Further troubleshooting 2023-09-28 15:55:39 -05:00
Rene Vergara d90f7cdfea
Troubleshoot the Sapling decode 2023-09-28 15:49:05 -05:00
Rene Vergara 78c8b9ef5c
Update Sapling decoding 2023-09-28 15:35:17 -05:00
Rene Vergara f0d1e933c6
Add debugging for shielded decode 2023-09-28 15:26:56 -05:00
Rene Vergara 5f32fd1142
Correct the Sapling decoding 2023-09-28 15:17:41 -05:00
Rene Vergara ae5606f4be
Update dep on `zcash-haskell` 2023-09-28 14:52:10 -05:00
Rene Vergara 82f6535765
Update `zcash-haskell` dependency 2023-09-28 14:26:49 -05:00
Rene Vergara 0f4a5f547f
Update deps to latest version of `zcash-haskell` 2023-09-28 13:59:07 -05:00
Rene Vergara b36f1240b0
Correct call to `getrawtransaction` 2023-09-28 13:37:23 -05:00
Rene Vergara 181f4bb749
Update base block for first run 2023-09-28 13:29:16 -05:00
Rene Vergara fb600aa5fc
Correct data type for `getblock` 2023-09-28 13:26:24 -05:00
Rene Vergara 85bf0fef59
Fix call to `getblock` 2023-09-28 13:11:48 -05:00
Rene Vergara a134947df6
Alpha version of native Tx scanning 2023-09-28 10:47:05 -05:00
Rene Vergara c5724d6d4a
Add tests for parsing UAs 2023-09-28 10:46:41 -05:00
Rene Vergara 51ae13e53b
Update to latest version of `zcash-haskell` 2023-09-28 10:21:29 -05:00
Rene Vergara 4c13ddcc48
Update code formatting 2023-09-27 13:42:51 -05:00
Rene Vergara fb436f1499
Add full validation of Sapling address to parser 2023-09-27 13:18:16 -05:00
Rene Vergara 528fdebe61
Add parser for Unified addresses 2023-09-27 13:12:02 -05:00
Rene Vergara c58aa2f8c0
Merge branch 'fix0057' into dev18 2023-08-14 09:00:27 -05:00
Rene Vergara 5ce72e5d95
Update test suite 2023-08-14 08:59:45 -05:00
Rene Vergara 7258af44c3
Enable the config file in test suite 2023-08-12 21:17:42 -05:00
Rene Vergara 2b7ce1d186
Merge branch 'fix0056' into dev18 2023-08-12 21:02:26 -05:00
Rene Vergara eda0f9336c
Fix issue 56 2023-08-12 20:41:27 -05:00
Rene Vergara bacb2369e0
Update MongoDB driver 2023-08-07 13:34:07 -05:00
Rene Vergara e586321faf
Update to new patched version of MongoDB driver 2023-07-27 13:34:35 -05:00
Rene Vergara e0f263f7f0
Test updates 2023-07-20 10:13:47 -05:00
Rene Vergara ea731df20d
Merge branch 'security1' 2023-06-26 11:28:33 -05:00
Rene Vergara 9376d959f8
New version preparation 2023-06-26 11:27:27 -05:00
Rene Vergara 6ae6dd8430
Update payment confirmation for new API endpoint 2023-06-26 09:50:12 -05:00
Rene Vergara e0c07091e9
Fix WooCommerce callback 2023-06-23 14:16:56 -05:00
Rene Vergara 51471cd58f
adjust WooCommerce callback 2023-06-23 13:13:20 -05:00
Rene Vergara 5ffb1b4a83
Add debugging to WooCommerce endpoint 2023-06-23 11:45:07 -05:00
Rene Vergara 7672cdc083
Update WooCommerce endpoint 2023-06-23 11:26:03 -05:00
Rene Vergara ac0e74c818
Correct `invdata` check of correct creation 2023-06-22 16:51:58 -05:00
Rene Vergara b49a996bf5
Correct session generation for Xero orders 2023-06-22 16:39:31 -05:00
Rene Vergara 013feabd20
Correct Xero payment confirmation 2023-06-22 16:16:33 -05:00
Rene Vergara 6e0cb54032
Add check of existing order 2023-06-22 13:38:33 -05:00
Rene Vergara 4bd49c76d4
Correct Zcash price handling in `invdata` 2023-06-22 11:52:36 -05:00
Rene Vergara fb0144bbe1
Correct currency check in `invdata` 2023-06-22 10:10:19 -05:00
Rene Vergara cd93f0031d
Correct HTTP codes for `invdata` 2023-06-22 08:26:55 -05:00
Rene Vergara 87efbf0613
Correct type of ownerId in XeroInvoiceRequest 2023-06-21 16:09:04 -05:00
Rene Vergara 547d5511fa
Add languange endpoint for pmtservice 2023-06-21 15:49:23 -05:00
Rene Vergara b638b4bbce
Add shop name to `invdata` 2023-06-21 14:59:34 -05:00
Rene Vergara bd4d611d04
Enhance `invdata` endpoint for Xero invoices 2023-06-21 14:29:41 -05:00
Rene Vergara f29c5ecb03
Rebuild `invdata` endpoint for Xero invoices 2023-06-21 11:15:30 -05:00
Rene Vergara aa3794b504
Modify xero endpoints 2023-06-20 13:27:53 -05:00
Rene Vergara f469ed6763
Add shop name to receipt endpoint 2023-06-20 08:54:28 -05:00
Rene Vergara f632b48f32
Add parameter for confirmation window 2023-06-20 07:54:24 -05:00
Rene Vergara aff5e4f03d
Add more debugging to payment confirmation 2023-06-19 18:54:18 -05:00
Rene Vergara ae198541ee
Add debugging to order payment 2023-06-19 18:06:21 -05:00
Rene Vergara 9a87d43459
Fix problem with payment confirmations 2023-06-19 17:54:21 -05:00
Rene Vergara f21700f88b
Improve payment confirmation 2023-06-19 16:58:39 -05:00
Rene Vergara e35304f030
Adjust CORS 2023-06-16 14:00:22 -05:00
Rene Vergara 05d0042a60
Add tests for new viewing key endpoint 2023-06-16 10:22:38 -05:00
Rene Vergara 9f64683474
Implement new endpoint for viewing keys
Mantis Issue 28
2023-06-15 19:40:58 -05:00
Rene Vergara 353c91204a
Enhance payment confirmation logic 2023-06-15 08:55:39 -05:00
Rene Vergara c2fc8b8ae9
Add tests for random WooToken 2023-06-12 15:48:23 -05:00
Rene Vergara e4e95b81b2
Add new JSON serialization for WooToken 2023-06-12 15:09:13 -05:00
Rene Vergara f625373e2e
Harden the wootoken endpoints 2023-06-09 10:51:42 -05:00
Rene Vergara 33df90eb96
Correct order endpoints 2023-06-05 07:47:51 -05:00
Rene Vergara 88ae856195
Add random token for orders 2023-06-02 13:51:17 -05:00
Rene Vergara 31eb42c1d5
Upgrade Haskell packages 2023-06-02 13:49:03 -05:00
Rene Vergara 9d81bd7472
Order endpoints corrections 2023-06-01 14:59:50 -05:00
Rene Vergara c8f1d250b5
Add tests for Item endpoints 2023-05-26 14:04:35 -05:00
Rene Vergara 857a298b96
Enhance `GET items` 2023-05-25 11:15:21 -05:00
Rene Vergara 958f04ee11
Harden user endpoints and corresponding tests 2023-05-17 11:46:24 -05:00
Rene Vergara ee95038a44
Update tests 2023-05-17 09:44:25 -05:00
Rene Vergara 9f13cbf302
Correct order payment logic 2023-05-16 14:27:10 -05:00
21 changed files with 2332 additions and 1004 deletions

View File

@ -4,7 +4,68 @@ 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).
## [1.5.0]
## [1.8.1]
### Changed
- Changed license to MIT
- Updated to Haskell LTS 21.22
- Update to new version of `zcash-haskell`
## [1.8.0]
### Added
- Parser for Unified Addresses that validates the address
- Tests for UA parsing from wallets
- Function to scan new transactions using known viewing keys
- Function to identify the owners and VKs needed for tx scans
### Changed
- Order endpoint updated to ensure orders belong to shop before adding to DB.
- MongoDB driver updated to support MongoDB 6.
- Full validation of Sapling addresses to parser.
### Removed
- `api/orderx` endpoint.
- `makeZcashCall` function moved to the generic `zcash-haskell` library.
- `RpcResponse`, `RpcCall` types moved to the generic `zcash-haskell` library.
## [1.7.0]
### Added
- Parameter to config for number of confirmations for scan
- Endpoint for language for invoices
### Changed
- Modified payment confirmation to use new WooCommerce plugin API endpoint.
- Consolidated the `invdata`, `orderid` and `orderx` endpoints
- The `xerotoken` endpoint uses `session` for authentication
- The order by ID/token endpoint includes shop name
### Fixed
- The viewing key obfuscation of blank viewing keys
## [1.6.0]
### Added
- New JSON serialization for WooTokens.
- New `/api/ownervk` endpoint to save viewing keys
- Use of `zcash-haskell` library to validate Sapling viewing keys
### Changed
- Modified the process of scanning for payments to only scan addresses that have an active ZGo session and have enabled payment confirmations
- Modified the process to mark paid orders to ensure only payments to the shop's wallet get marked as paid
- Modified the `items` endpoint to use the login session to identify records
## [1.5.0] - 2023-05-15
### Added

View File

@ -1,7 +0,0 @@
Copyright (c) 2022 Vergara Technologies LLC
This package ("Original Work") is licensed under the terms of the Bootstrap
Open Source License, version 1.0, or at your option, any later version
("BOSL"). See the file ./LICENSE for the terms of the Bootstrap Open Source
Licence, version 1.0.

191
LICENSE
View File

@ -1,178 +1,21 @@
Copyright (c) 2023 Vergara Technologies LLC
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;
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.
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.

View File

@ -6,7 +6,8 @@ The API server behind the [ZGo.cash](https://zgo.cash) app.
## Dependencies
- Zcash Full node
- Zcash Full node (`zcashd`)
- [Zcash Haskell](https://git.vergara.tech/Vergara_Tech/zcash-haskell)
- MongoDB
## Configuration

View File

@ -23,10 +23,12 @@ main = do
putStrLn "Connected to MongoDB!"
checkZcashPrices pipe (c_dbName loadedConfig)
scanZcash' loadedConfig pipe
scanPayments loadedConfig pipe
{-scanPayments loadedConfig pipe-}
scanTxNative loadedConfig pipe
checkPayments pipe (c_dbName loadedConfig)
expireOwners pipe (c_dbName loadedConfig)
updateLogins pipe loadedConfig
expireProSessions pipe (c_dbName loadedConfig)
loadTranslations pipe loadedConfig
close pipe
else fail "MongoDB connection failed!"

View File

@ -1,10 +1,10 @@
name: zgo-backend
version: 1.5.0
version: 1.8.1
git: "https://git.vergara.tech/Vergara_Tech/zgo-backend"
license: BOSL
license: MIT
author: "Rene Vergara"
maintainer: "rene@vergara.network"
copyright: "Copyright (c) 2023 Vergara Technologies LLC"
copyright: "2022-2024 Vergara Technologies LLC"
extra-source-files:
- README.md
@ -62,6 +62,7 @@ library:
- crypto-rng
- megaparsec
- uuid
- zcash-haskell
executables:
zgo-backend-exe:
@ -161,3 +162,6 @@ tests:
- time
- configurator
- scotty
- megaparsec
- uuid
- zcash-haskell

View File

@ -26,6 +26,7 @@ data Config =
, c_smtpPort :: Integer
, c_smtpUser :: String
, c_smtpPwd :: String
, c_confirmations :: Integer
}
deriving (Eq, Show)
@ -48,6 +49,7 @@ loadZGoConfig path = do
mailPort <- require config "smtpPort"
mailUser <- require config "smtpUser"
mailPwd <- require config "smtpPwd"
conf <- require config "confirmations"
return $
Config
dbHost
@ -66,3 +68,4 @@ loadZGoConfig path = do
mailPort
mailUser
mailPwd
conf

View File

@ -12,6 +12,7 @@ import Data.Time.Clock
import Database.MongoDB
import GHC.Generics
import Test.QuickCheck
import User
-- | Type to represent a ZGo item
data Item =
@ -87,6 +88,9 @@ findItems :: T.Text -> Action IO [Document]
findItems a =
rest =<< find (select ["owner" =: a] "items") {sort = ["name" =: (1 :: Int)]}
findItemById :: String -> Action IO (Maybe Document)
findItemById i = findOne (select ["_id" =: (read i :: ObjectId)] "items")
upsertItem :: Item -> Action IO ()
upsertItem i = do
let item = val i

View File

@ -12,28 +12,31 @@ import Data.Time.Clock
import Database.MongoDB
import GHC.Generics
import Test.QuickCheck
import WooCommerce (WooToken(w_id))
-- | Type to represent a ZGo order
data ZGoOrder =
ZGoOrder
{ q_id :: Maybe ObjectId
, qaddress :: T.Text
, qsession :: T.Text
, qtimestamp :: UTCTime
, qclosed :: Bool
, qcurrency :: T.Text
, qprice :: Double
, qtotal :: Double
, qtotalZec :: Double
, qlines :: [LineItem]
, qpaid :: Bool
, qexternalInvoice :: T.Text
, qshortCode :: T.Text
}
deriving (Eq, Show, Generic)
data ZGoOrder = ZGoOrder
{ q_id :: Maybe ObjectId
, qaddress :: T.Text
, qsession :: T.Text
, qtimestamp :: UTCTime
, qclosed :: Bool
, qcurrency :: T.Text
, qprice :: Double
, qtotal :: Double
, qtotalZec :: Double
, qlines :: [LineItem]
, qpaid :: Bool
, qexternalInvoice :: T.Text
, qshortCode :: T.Text
, qtoken :: T.Text
, qtax :: Double
, qvat :: Double
, qtip :: Double
} deriving (Eq, Show, Generic)
instance ToJSON ZGoOrder where
toJSON (ZGoOrder i a s ts c cur p t tZ l paid eI sC) =
toJSON (ZGoOrder i a s ts c cur p t tZ l paid eI sC tk qT qV tip) =
case i of
Just oid ->
object
@ -50,6 +53,10 @@ instance ToJSON ZGoOrder where
, "paid" .= paid
, "externalInvoice" .= eI
, "shortCode" .= sC
, "token" .= tk
, "taxAmount" .= qT
, "vatAmount" .= qV
, "tipAmount" .= tip
]
Nothing ->
object
@ -66,6 +73,10 @@ instance ToJSON ZGoOrder where
, "paid" .= paid
, "externalInvoice" .= eI
, "shortCode" .= sC
, "token" .= tk
, "taxAmount" .= qT
, "vatAmount" .= qV
, "tipAmount" .= tip
]
instance FromJSON ZGoOrder where
@ -84,10 +95,14 @@ instance FromJSON ZGoOrder where
pd <- obj .: "paid"
eI <- obj .: "externalInvoice"
sC <- obj .: "shortCode"
tk <- obj .: "token"
qT <- obj .: "taxAmount"
qV <- obj .: "vatAmount"
tip <- obj .: "tipAmount"
pure $
ZGoOrder
(if not (null i)
then Just (read i)
then Just (read i :: ObjectId)
else Nothing)
a
s
@ -101,9 +116,13 @@ instance FromJSON ZGoOrder where
pd
eI
sC
tk
qT
qV
tip
instance Val ZGoOrder where
val (ZGoOrder i a s ts c cur p t tZ l pd eI sC) =
val (ZGoOrder i a s ts c cur p t tZ l pd eI sC tk qT qV tip) =
if isJust i
then Doc
[ "_id" =: i
@ -119,6 +138,10 @@ instance Val ZGoOrder where
, "paid" =: pd
, "externalInvoice" =: eI
, "shortCode" =: sC
, "token" =: tk
, "taxAmount" =: qT
, "vatAmount" =: qV
, "tipAmount" =: tip
]
else Doc
[ "address" =: a
@ -133,6 +156,10 @@ instance Val ZGoOrder where
, "paid" =: pd
, "externalInvoice" =: eI
, "shortCode" =: sC
, "token" =: tk
, "taxAmount" =: qT
, "vatAmount" =: qV
, "tipAmount" =: tip
]
cast' (Doc d) = do
i <- B.lookup "_id" d
@ -148,17 +175,19 @@ instance Val ZGoOrder where
pd <- B.lookup "paid" d
eI <- B.lookup "externalInvoice" d
sC <- B.lookup "shortCode" d
Just (ZGoOrder i a s ts c cur p t tZ l pd eI sC)
tk <- B.lookup "token" d
qT <- B.lookup "taxAmount" d
qV <- B.lookup "vatAmount" d
tip <- B.lookup "tipAmount" d
Just (ZGoOrder i a s ts c cur p t tZ l pd eI sC tk qT qV tip)
cast' _ = Nothing
-- Type to represent an order line item
data LineItem =
LineItem
{ lqty :: Double
, lname :: T.Text
, lcost :: Double
}
deriving (Eq, Show)
data LineItem = LineItem
{ lqty :: Double
, lname :: T.Text
, lcost :: Double
} deriving (Eq, Show)
instance ToJSON LineItem where
toJSON (LineItem q n c) = object ["qty" .= q, "name" .= n, "cost" .= c]
@ -181,33 +210,40 @@ instance Val LineItem where
cast' _ = Nothing
-- Database actions
upsertOrder :: ZGoOrder -> Action IO ()
upsertOrder o = do
let order = val $ updateOrderTotals o
upsertOrder :: ZGoOrder -> Double -> Double -> Action IO ()
upsertOrder o taxRate vatRate = do
let order = val $ updateOrderTotals o taxRate vatRate
case order of
Doc d ->
Doc d ->
if isJust (q_id o)
then upsert (select ["_id" =: q_id o] "orders") d
else insert_ "orders" d
then upsert (select ["_id" =: q_id o] "orders") d
else insert_ "orders" d
_ -> return ()
insertWooOrder :: ZGoOrder -> Action IO Database.MongoDB.Value
insertWooOrder o = do
let order = val $ updateOrderTotals o
let order = val $ updateOrderTotals o 0 0
case order of
Doc d -> insert "orders" d
_ -> fail "Couldn't parse order"
upsertXeroOrder :: ZGoOrder -> Action IO ()
upsertXeroOrder o = do
let order = val $ updateOrderTotals o
let order = val $ updateOrderTotals o 0 0
case order of
Doc d -> upsert (select ["externalInvoice" =: qexternalInvoice o, "shortCode" =: qshortCode o] "orders") d
Doc d ->
upsert
(select
[ "externalInvoice" =: qexternalInvoice o
, "shortCode" =: qshortCode o
]
"orders")
d
_ -> return ()
-- | Function to update order totals from items
updateOrderTotals :: ZGoOrder -> ZGoOrder
updateOrderTotals o =
updateOrderTotals :: ZGoOrder -> Double -> Double -> ZGoOrder
updateOrderTotals o taxRate vatRate =
ZGoOrder
(q_id o)
(qaddress o)
@ -216,31 +252,51 @@ updateOrderTotals o =
(qclosed o)
(qcurrency o)
(qprice o)
(newTotal o)
(newTotal o taxRate vatRate)
(if qprice o /= 0
then roundZec (newTotal o / qprice o)
then roundZec (newTotal o taxRate vatRate / qprice o)
else 0)
(qlines o)
(qpaid o)
(qexternalInvoice o)
(qshortCode o)
(qtoken o)
(updateTax o taxRate)
(updateTax o vatRate)
(qtip o)
where
newTotal :: ZGoOrder -> Double
newTotal x = foldr tallyItems 0 (qlines x)
updateTax :: ZGoOrder -> Double -> Double
updateTax x t = roundFiat $ itemsTotal (qlines x) * t / 100.0
itemsTotal :: [LineItem] -> Double
itemsTotal = foldr tallyItems 0
newTotal :: ZGoOrder -> Double -> Double -> Double
newTotal x tR vR =
itemsTotal (qlines x) + updateTax x tR + updateTax x vR + qtip x
tallyItems :: LineItem -> Double -> Double
tallyItems y z = (lqty y * lcost y) + z
setOrderToken :: T.Text -> ZGoOrder -> ZGoOrder
setOrderToken token (ZGoOrder i a s ts c cur p t tZ l pd eI sC tk qT qV tip) =
ZGoOrder i a s ts c cur p t tZ l pd eI sC token qT qV tip
findOrder :: T.Text -> Action IO (Maybe Document)
findOrder s = findOne (select ["session" =: s, "closed" =: False] "orders")
findXeroOrder :: T.Text -> T.Text -> T.Text -> Action IO (Maybe Document)
findXeroOrder a i s = findOne (select ["address" =: a, "externalInvoice" =: i, "shortCode" =: s] "orders")
findXeroOrder a i s =
findOne
(select ["address" =: a, "externalInvoice" =: i, "shortCode" =: s] "orders")
findOrderById :: String -> Action IO (Maybe Document)
findOrderById "0" = return Nothing
findOrderById i = findOne (select ["_id" =: (read i :: B.ObjectId)] "orders")
findAllOrders :: T.Text -> Action IO [Document]
findAllOrders a = rest =<< find (select ["address" =: a] "orders") {sort = ["timestamp" =: (negate 1 :: Int)]}
findAllOrders a =
rest =<<
find
(select ["address" =: a] "orders")
{sort = ["timestamp" =: (negate 1 :: Int)]}
deleteOrder :: String -> Action IO ()
deleteOrder i = deleteOne (select ["_id" =: (read i :: B.ObjectId)] "orders")
@ -255,3 +311,6 @@ markOrderPaid (i, a) = do
-- | Helper function to round to 8 decimal places
roundZec :: Double -> Double
roundZec n = fromInteger (round $ n * (10 ^ 8)) / (10.0 ^^ 8)
roundFiat :: Double -> Double
roundFiat n = fromInteger (round $ n * (10 ^ 2)) / (10.0 ^^ 2)

View File

@ -14,38 +14,37 @@ import Database.MongoDB
import GHC.Generics
-- | Type to represent a ZGo shop owner/business
data Owner =
Owner
{ o_id :: Maybe ObjectId
, oaddress :: T.Text
, oname :: T.Text
, ocurrency :: T.Text
, otax :: Bool
, otaxValue :: Double
, ovat :: Bool
, ovatValue :: Double
, ofirst :: T.Text
, olast :: T.Text
, oemail :: T.Text
, ostreet :: T.Text
, ocity :: T.Text
, ostate :: T.Text
, opostal :: T.Text
, ophone :: T.Text
, owebsite :: T.Text
, ocountry :: T.Text
, opaid :: Bool
, ozats :: Bool
, oinvoices :: Bool
, oexpiration :: UTCTime
, opayconf :: Bool
, oviewkey :: T.Text
, ocrmToken :: T.Text
}
deriving (Eq, Show, Generic, Typeable)
data Owner = Owner
{ o_id :: Maybe ObjectId
, oaddress :: T.Text
, oname :: T.Text
, ocurrency :: T.Text
, otax :: Bool
, otaxValue :: Double
, ovat :: Bool
, ovatValue :: Double
, ofirst :: T.Text
, olast :: T.Text
, oemail :: T.Text
, ostreet :: T.Text
, ocity :: T.Text
, ostate :: T.Text
, opostal :: T.Text
, ophone :: T.Text
, owebsite :: T.Text
, ocountry :: T.Text
, opaid :: Bool
, ozats :: Bool
, oinvoices :: Bool
, oexpiration :: UTCTime
, opayconf :: Bool
, oviewkey :: T.Text
, ocrmToken :: T.Text
, otips :: Bool
} deriving (Eq, Show, Generic, Typeable)
instance ToJSON Owner where
toJSON (Owner i a n c t tV v vV f l e s ct st p ph w co paid zats inv eTs pc vk cT) =
toJSON (Owner i a n c t tV v vV f l e s ct st p ph w co paid zats inv eTs pc vk cT oT) =
case i of
Just oid ->
object
@ -74,6 +73,7 @@ instance ToJSON Owner where
, "payconf" .= pc
, "viewkey" .= vk
, "crmToken" .= cT
, "tips" .= oT
]
Nothing ->
object
@ -102,6 +102,7 @@ instance ToJSON Owner where
, "payconf" .= pc
, "viewkey" .= vk
, "crmToken" .= cT
, "tips" .= oT
]
instance FromJSON Owner where
@ -132,6 +133,7 @@ instance FromJSON Owner where
pc <- obj .:? "payconf"
vk <- obj .:? "viewkey"
cT <- obj .:? "crmToken"
oT <- obj .:? "tips"
pure $
Owner
(if not (null i)
@ -161,6 +163,7 @@ instance FromJSON Owner where
(fromMaybe False pc)
(fromMaybe "" vk)
(fromMaybe "" cT)
(fromMaybe False oT)
instance Val Owner where
cast' (Doc d) = do
@ -189,6 +192,7 @@ instance Val Owner where
pc <- B.lookup "payconf" d
vk <- B.lookup "viewKey" d
cT <- B.lookup "crmToken" d
oT <- B.lookup "tips" d
Just
(Owner
i
@ -215,9 +219,10 @@ instance Val Owner where
ets
pc
vk
cT)
cT
oT)
cast' _ = Nothing
val (Owner i a n c t tV v vV f l e s ct st p ph w co paid zats inv ets pc vk cT) =
val (Owner i a n c t tV v vV f l e s ct st p ph w co paid zats inv ets pc vk cT oT) =
case i of
Just oid ->
Doc
@ -246,6 +251,7 @@ instance Val Owner where
, "payconf" =: pc
, "viewKey" =: vk
, "crmToken" =: cT
, "tips" =: oT
]
Nothing ->
Doc
@ -273,24 +279,23 @@ instance Val Owner where
, "payconf" =: pc
, "viewKey" =: vk
, "crmToken" =: cT
, "tips" =: oT
]
-- | Type to represent informational data for Owners from UI
data OwnerData =
OwnerData
{ od_first :: T.Text
, od_last :: T.Text
, od_name :: T.Text
, od_street :: T.Text
, od_city :: T.Text
, od_state :: T.Text
, od_postal :: T.Text
, od_country :: T.Text
, od_email :: T.Text
, od_website :: T.Text
, od_phone :: T.Text
}
deriving (Eq, Show, Generic)
data OwnerData = OwnerData
{ od_first :: T.Text
, od_last :: T.Text
, od_name :: T.Text
, od_street :: T.Text
, od_city :: T.Text
, od_state :: T.Text
, od_postal :: T.Text
, od_country :: T.Text
, od_email :: T.Text
, od_website :: T.Text
, od_phone :: T.Text
} deriving (Eq, Show, Generic)
instance FromJSON OwnerData where
parseJSON =
@ -308,25 +313,24 @@ instance FromJSON OwnerData where
ph <- obj .: "phone"
pure $ OwnerData f l n s c st p co e w ph
data OwnerSettings =
OwnerSettings
{ os_id :: Maybe ObjectId
, os_address :: T.Text
, os_name :: T.Text
, os_currency :: T.Text
, os_tax :: Bool
, os_taxValue :: Double
, os_vat :: Bool
, os_vatValue :: Double
, os_paid :: Bool
, os_zats :: Bool
, os_invoices :: Bool
, os_expiration :: UTCTime
, os_payconf :: Bool
, os_crmToken :: T.Text
, os_viewKey :: T.Text
}
deriving (Eq, Show, Generic)
data OwnerSettings = OwnerSettings
{ os_id :: Maybe ObjectId
, os_address :: T.Text
, os_name :: T.Text
, os_currency :: T.Text
, os_tax :: Bool
, os_taxValue :: Double
, os_vat :: Bool
, os_vatValue :: Double
, os_paid :: Bool
, os_zats :: Bool
, os_invoices :: Bool
, os_expiration :: UTCTime
, os_payconf :: Bool
, os_crmToken :: T.Text
, os_viewKey :: T.Text
, os_tips :: Bool
} deriving (Eq, Show, Generic)
instance FromJSON OwnerSettings where
parseJSON =
@ -346,11 +350,28 @@ instance FromJSON OwnerSettings where
pc <- obj .: "payconf"
cT <- obj .: "crmToken"
vK <- obj .: "viewkey"
oT <- obj .: "tips"
pure $
OwnerSettings ((Just . read) =<< i) a n c t tV v vV p z inv e pc cT vK
OwnerSettings
((Just . read) =<< i)
a
n
c
t
tV
v
vV
p
z
inv
e
pc
cT
vK
oT
instance ToJSON OwnerSettings where
toJSON (OwnerSettings i a n c t tV v vV p z inv e pc cT vK) =
toJSON (OwnerSettings i a n c t tV v vV p z inv e pc cT vK oT) =
object
[ "_id" .= maybe "" show i
, "address" .= a
@ -366,8 +387,13 @@ instance ToJSON OwnerSettings where
, "expiration" .= e
, "payconf" .= pc
, "crmToken" .= cT
, "viewkey" .= (T.take 8 vK <> "...." <> T.takeEnd 8 vK)
, "viewkey" .= keyObfuscate vK
, "tips" .= oT
]
where
keyObfuscate s
| s == "" = ""
| otherwise = T.take 8 s <> "...." <> T.takeEnd 8 s
-- Helper Functions
getOwnerSettings :: Owner -> OwnerSettings
@ -388,6 +414,7 @@ getOwnerSettings o =
(opayconf o)
(ocrmToken o)
(oviewkey o)
(otips o)
-- Database actions
-- | Function to upsert an Owner
@ -407,6 +434,10 @@ findOwnerById :: T.Text -> Action IO (Maybe Document)
findOwnerById i =
findOne (select ["_id" =: (read (T.unpack i) :: ObjectId)] "owners")
findActiveOwners :: Action IO [Document]
findActiveOwners =
rest =<< find (select ["paid" =: True, "payconf" =: True] "owners")
-- | Function to find Owners about to expire
findExpiringOwners :: UTCTime -> Action IO [Document]
findExpiringOwners now =
@ -416,6 +447,10 @@ findExpiringOwners now =
["paid" =: True, "expiration" =: ["$lte" =: addUTCTime 172800 now]]
"owners")
findWithKeys :: Action IO [Document]
findWithKeys =
rest =<< find (select ["paid" =: True, "payconf" =: True] "owners")
removePro :: T.Text -> Action IO ()
removePro o =
modify (select ["address" =: o] "owners") ["$set" =: ["invoices" =: False]]
@ -434,18 +469,21 @@ updateOwnerSettings os =
, "zats" =: os_zats os
, "payconf" =: os_payconf os
, "crmToken" =: os_crmToken os
, "tips" =: os_tips os
]
]
upsertViewingKey :: Owner -> String -> Action IO ()
upsertViewingKey o vk =
modify (select ["_id" =: o_id o] "owners") ["$set" =: ["viewKey" =: vk]]
-- | Type for a pro session
data ZGoProSession =
ZGoProSession
{ ps_id :: Maybe ObjectId
, psaddress :: T.Text
, psexpiration :: UTCTime
, psclosed :: Bool
}
deriving (Eq, Show)
data ZGoProSession = ZGoProSession
{ ps_id :: Maybe ObjectId
, psaddress :: T.Text
, psexpiration :: UTCTime
, psclosed :: Bool
} deriving (Eq, Show)
instance Val ZGoProSession where
cast' (Doc d) = do

View File

@ -69,6 +69,36 @@ instance FromJSON User where
""
v
instance Val User where
cast' (Doc d) = do
i <- B.lookup "_id" d
a <- B.lookup "address" d
s <- B.lookup "session" d
b <- B.lookup "blocktime" d
p <- B.lookup "pin" d
v <- B.lookup "validated" d
Just $ User i a s b p v
cast' _ = Nothing
val (User i a s b p v) =
case i of
Just oid ->
Doc
[ "_id" =: oid
, "address" =: a
, "session" =: s
, "blocktime" =: b
, "pin" =: p
, "validated" =: v
]
Nothing ->
Doc
[ "address" =: a
, "session" =: s
, "blocktime" =: b
, "pin" =: p
, "validated" =: v
]
parseUserBson :: B.Document -> Maybe User
parseUserBson d = do
i <- B.lookup "_id" d
@ -84,6 +114,9 @@ parseUserBson d = do
findUser :: T.Text -> Action IO (Maybe Document)
findUser s = findOne (select ["session" =: s] "users")
findUserById :: String -> Action IO (Maybe Document)
findUserById i = findOne (select ["_id" =: (read i :: B.ObjectId)] "users")
-- | Function to delete user by ID
deleteUser :: String -> Action IO ()
deleteUser i = deleteOne (select ["_id" =: (read i :: B.ObjectId)] "users")

View File

@ -28,6 +28,29 @@ data WooToken =
}
deriving (Eq, Show)
instance FromJSON WooToken where
parseJSON =
withObject "WooToken" $ \obj -> do
i <- obj .:? "_id"
o <- obj .: "ownerid"
t <- obj .: "token"
u <- obj .: "siteurl"
pure $ WooToken (read <$> i) (read o) t u
instance ToJSON WooToken where
toJSON (WooToken i o t u) =
case i of
Just oid ->
object
["_id" .= show oid, "ownerid" .= show o, "token" .= t, "siteurl" .= u]
Nothing ->
object
[ "_id" .= ("" :: String)
, "ownerid" .= show o
, "token" .= t
, "siteurl" .= u
]
instance Val WooToken where
val (WooToken i o t u) =
if isJust i
@ -47,8 +70,11 @@ instance Val WooToken where
cast' _ = Nothing
-- Database actions
findWooToken :: ObjectId -> Action IO (Maybe Document)
findWooToken oid = findOne (select ["owner" =: oid] "wootokens")
findWooToken :: Maybe ObjectId -> Action IO (Maybe Document)
findWooToken oid =
case oid of
Nothing -> return Nothing
Just o -> findOne (select ["owner" =: o] "wootokens")
addUrl :: WooToken -> T.Text -> Action IO ()
addUrl t u =
@ -63,8 +89,9 @@ payWooOrder ::
-> BS.ByteString -- Total ZEC for order
-> IO ()
payWooOrder u i o t p z = do
wooReq <- parseRequest $ u ++ "/wc-api/zpmtcallback"
wooReq <- parseRequest u
let req =
setRequestPath "/wp-json/wc/v3/zgocallback" $
setRequestQueryString
[ ("token", Just t)
, ("orderid", Just o)
@ -77,23 +104,15 @@ payWooOrder u i o t p z = do
res <- httpLBS req
if getResponseStatus res == ok200
then return ()
else error "Failed to report payment to WooCommerce"
else do
print $ getResponseStatus res
error "Failed to report payment to WooCommerce"
generateWooToken :: Owner -> Action IO ()
generateWooToken o =
generateWooToken :: Owner -> String -> Action IO ()
generateWooToken o s =
case o_id o of
Just ownerid -> do
let tokenHash =
BLK.hash
[ BA.pack . BS.unpack . C.pack . T.unpack $ oname o <> oaddress o :: BA.Bytes
]
let wooToken =
val $
WooToken
Nothing
ownerid
(T.pack . show $ (tokenHash :: BLK.Digest BLK.DEFAULT_DIGEST_LEN))
Nothing
let wooToken = val $ WooToken Nothing ownerid (T.pack s) Nothing
case wooToken of
Doc wT -> insert_ "wootokens" wT
_ -> error "Couldn't create the WooCommerce token"

View File

@ -171,6 +171,26 @@ instance FromJSON XeroTenant where
--u <- obj .: "updatedDateUtc"
pure $ XeroTenant i aei tI tT tN
data XeroInvoiceRequest =
XeroInvoiceRequest
{ xr_owner :: T.Text
, xr_invNo :: T.Text
, xr_amount :: Double
, xr_currency :: T.Text
, xr_shortCode :: T.Text
}
deriving (Show, Eq)
instance FromJSON XeroInvoiceRequest where
parseJSON =
withObject "XeroInvoiceRequest" $ \obj -> do
o <- obj .: "ownerId"
i <- obj .: "invoice"
a <- obj .: "amount"
c <- obj .: "currency"
s <- obj .: "shortcode"
pure $ XeroInvoiceRequest o i a c s
data XeroInvoice =
XeroInvoice
{ xi_id :: Maybe ObjectId
@ -443,5 +463,6 @@ payXeroInvoice pipe dbName inv address amt zec = do
setRequestHost "api.xero.com" $
setRequestMethod "PUT" defaultRequest
res <- httpJSON req :: IO (Response Object)
print res
return ()
else error "Invalid parameters"

File diff suppressed because it is too large Load Diff

View File

@ -9,26 +9,27 @@ import qualified Data.Bson as B
import Data.Char
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import qualified Data.UUID as U
import Data.Void
import Database.MongoDB
import GHC.Generics
import Text.Megaparsec hiding (State)
import Text.Megaparsec.Char
import ZcashHaskell.Orchard
import ZcashHaskell.Sapling (isValidShieldedAddress)
-- | Type to model a ZGo transaction
data ZGoTx =
ZGoTx
{ _id :: Maybe ObjectId
, address :: T.Text
, session :: T.Text
, confirmations :: Integer
, blocktime :: Integer
, amount :: Double
, txid :: T.Text
, memo :: T.Text
}
deriving (Eq, Show, Generic)
data ZGoTx = ZGoTx
{ _id :: Maybe ObjectId
, address :: T.Text
, session :: T.Text
, confirmations :: Integer
, blocktime :: Integer
, amount :: Double
, txid :: T.Text
, memo :: T.Text
} deriving (Eq, Show, Generic)
parseZGoTxBson :: B.Document -> Maybe ZGoTx
parseZGoTxBson d = do
@ -100,26 +101,25 @@ instance Val ZGoTx where
]
-- | Type to represent and parse ZGo memos
data ZGoMemo =
ZGoMemo
{ m_session :: Maybe U.UUID
, m_address :: Maybe T.Text
, m_payment :: Bool
}
deriving (Eq, Show)
data ZGoMemo = ZGoMemo
{ m_session :: Maybe U.UUID
, m_address :: Maybe T.Text
, m_payment :: Bool
, m_orderId :: Maybe T.Text
} deriving (Eq, Show)
data MemoToken
= Login !U.UUID
| PayMsg !U.UUID
| Address !T.Text
| Msg !T.Text
| OrderId !T.Text
deriving (Show, Eq)
type Parser = Parsec Void T.Text
pSession :: Parser MemoToken
pSession = do
optional spaceChar
string "ZGO"
pay <- optional $ char 'p'
string "::"
@ -136,19 +136,38 @@ pSaplingAddress :: Parser MemoToken
pSaplingAddress = do
string "zs"
a <- some alphaNumChar
if length a /= 76
then fail "Failed to parse Sapling address"
else pure $ Address $ T.pack ("zs" <> a)
if isValidShieldedAddress (E.encodeUtf8 $ "zs" <> T.pack a)
then pure $ Address $ T.pack ("zs" <> a)
else fail "Failed to parse Sapling address"
pUnifiedAddress :: Parser MemoToken
pUnifiedAddress = do
string "u1"
a <- some alphaNumChar
case isValidUnifiedAddress (E.encodeUtf8 $ "u1" <> T.pack a) of
Just u -> pure $ Address $ T.pack ("u1" <> a)
Nothing -> fail "Failed to parse Unified Address"
pOrderId :: Parser MemoToken
pOrderId = do
string "ZGo Order::"
a <- some hexDigitChar
pure $ OrderId . T.pack $ a
pMsg :: Parser MemoToken
pMsg = do
Msg . T.pack <$>
some (alphaNumChar <|> punctuationChar <|> charCategory OtherSymbol)
msg <-
some
(alphaNumChar <|> punctuationChar <|> symbolChar <|>
charCategory OtherSymbol)
pure $ Msg . T.pack $ msg
pMemo :: Parser MemoToken
pMemo = do
optional spaceChar
pSession <|> pSaplingAddress <|> pMsg
optional $ some spaceChar
t <- pSession <|> pSaplingAddress <|> pUnifiedAddress <|> pOrderId <|> pMsg
optional $ some spaceChar
return t
isMemoToken :: T.Text -> MemoToken -> Bool
isMemoToken kind t =
@ -171,8 +190,15 @@ isMemoToken kind t =
pZGoMemo :: Parser ZGoMemo
pZGoMemo = do
tks <- some pMemo
pure $ ZGoMemo (isSession tks) (isAddress tks) (isPayment tks)
pure $ ZGoMemo (isSession tks) (isAddress tks) (isPayment tks) (isOrder tks)
where
isOrder [] = Nothing
isOrder tks =
if not (null tks)
then case head tks of
OrderId x -> Just x
_ -> isOrder $ tail tks
else Nothing
isPayment [] = False
isPayment tks =
not (null tks) &&

View File

@ -17,7 +17,7 @@
#
# resolver: ./custom-snapshot.yaml
# resolver: https://example.com/snapshots/2018-01-01.yaml
resolver: lts-20.19
resolver: lts-21.22
#url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/4.yaml
# User packages to be built.
@ -42,8 +42,23 @@ packages:
#
# extra-deps: []
extra-deps:
- git: https://github.com/reach-sh/haskell-hexstring.git
#- git: https://github.com/reach-sh/haskell-hexstring.git
#commit: 085c16fb21b9f856a435a3faab980e7e0b319341
- git: https://git.vergara.tech/Vergara_Tech/haskell-hexstring.git
commit: 085c16fb21b9f856a435a3faab980e7e0b319341
- git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
commit: dce171d83043fae0e5c771ff743d31c4ec19c1ae
- git: https://git.vergara.tech/Vergara_Tech/haskell-foreign-rust.git
commit: 787c2e813eb3a5d16c375d4b37dfefbd2adcdf05
- git: https://github.com/well-typed/borsh.git
commit: d2fcfa159e0a844b1ec5e8ed3e232d4b380fa831
- git: https://git.vergara.tech/Vergara_Tech/mongodb.git
commit: 63bba3a6d30e5fd73c71fd7da752b2647d94f58e
# - network-2.8.0.1@sha256:a79f3cf88b2623d5f2e7a8fc7962055f6858d6beb6d13c2aef43c20a5060cf28,3034
- aeson-2.1.2.1@sha256:5b8d62a60963a925c4d123a46e42a8e235a32188522c9f119f64ac228c2612a7,6359
- vector-0.13.0.0@sha256:fa5cac81a17a5af388716792e8b99c24b3b66770086756d0d8b23f8272a0244c,9112
- generically-0.1.1
- vector-algorithms-0.9.0.1
- blake3-0.2@sha256:d1146b9a51ccfbb0532780778b6d016a614e3d44c05d8c1923dde9a8be869045,2448
- crypto-rng-0.3.0.1@sha256:04f4ae75943ecad8b794950985054130f272d65a588b6b6528f56df0bfedc4dc,1565
# Override default flag values for local packages and extra-deps

View File

@ -6,7 +6,7 @@
packages:
- completed:
commit: 085c16fb21b9f856a435a3faab980e7e0b319341
git: https://github.com/reach-sh/haskell-hexstring.git
git: https://git.vergara.tech/Vergara_Tech/haskell-hexstring.git
name: hexstring
pantry-tree:
sha256: 9ecf67856f59dfb382b283eceb42e4fc1865935d1a7e59111556ed381c6a2ffd
@ -14,7 +14,79 @@ packages:
version: 0.11.1
original:
commit: 085c16fb21b9f856a435a3faab980e7e0b319341
git: https://github.com/reach-sh/haskell-hexstring.git
git: https://git.vergara.tech/Vergara_Tech/haskell-hexstring.git
- completed:
commit: dce171d83043fae0e5c771ff743d31c4ec19c1ae
git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
name: zcash-haskell
pantry-tree:
sha256: 000770930e5d50596b82b38984d6e8ab94fd5345c7fcf3cc21682ef8e6348746
size: 1365
version: 0.3.0
original:
commit: dce171d83043fae0e5c771ff743d31c4ec19c1ae
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: 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:
commit: 63bba3a6d30e5fd73c71fd7da752b2647d94f58e
git: https://git.vergara.tech/Vergara_Tech/mongodb.git
name: mongoDB
pantry-tree:
sha256: 63af9dc2612131fb5d1ea9d75b7055d5d0b28ca443149be1fb47c22bf204128f
size: 2297
version: 2.7.1.2
original:
commit: 63bba3a6d30e5fd73c71fd7da752b2647d94f58e
git: https://git.vergara.tech/Vergara_Tech/mongodb.git
- completed:
hackage: aeson-2.1.2.1@sha256:5b8d62a60963a925c4d123a46e42a8e235a32188522c9f119f64ac228c2612a7,6359
pantry-tree:
sha256: 58d33beedd6e0ff79920c636d8a4295deb684b6e97c9b1ca94d3c780958d6302
size: 82465
original:
hackage: aeson-2.1.2.1@sha256:5b8d62a60963a925c4d123a46e42a8e235a32188522c9f119f64ac228c2612a7,6359
- 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:2b9b5efb6eea2fb65377565d53d85b0ccc5b37404fba4bef1d60277caa877e5e,1155
pantry-tree:
sha256: 98a8fe89d516d3752a9cc0af22cfa652f098cc6613da080762b63aa1d596e56d
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
- completed:
hackage: blake3-0.2@sha256:d1146b9a51ccfbb0532780778b6d016a614e3d44c05d8c1923dde9a8be869045,2448
pantry-tree:
@ -31,7 +103,7 @@ packages:
hackage: crypto-rng-0.3.0.1@sha256:04f4ae75943ecad8b794950985054130f272d65a588b6b6528f56df0bfedc4dc,1565
snapshots:
- completed:
sha256: 42f77c84b34f68c30c2cd0bf8c349f617a0f428264362426290847a6a2019b64
size: 649618
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/19.yaml
original: lts-20.19
sha256: afd5ba64ab602cabc2d3942d3d7e7dd6311bc626dcb415b901eaf576cb62f0ea
size: 640060
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/21/22.yaml
original: lts-21.22

File diff suppressed because it is too large Load Diff

View File

@ -1,18 +1,18 @@
cabal-version: 1.12
-- This file has been generated from package.yaml by hpack version 0.35.1.
-- This file has been generated from package.yaml by hpack version 0.36.0.
--
-- see: https://github.com/sol/hpack
name: zgo-backend
version: 1.5.0
version: 1.8.1
synopsis: Haskell Back-end for the ZGo point-of-sale application
description: Please see the README at <https://git.vergara.tech/Vergara_Tech//zgo-backend#readme>
category: Web
author: Rene Vergara
maintainer: rene@vergara.network
copyright: Copyright (c) 2023 Vergara Technologies LLC
license: BOSL
copyright: 2022-2024 Vergara Technologies LLC
license: MIT
license-file: LICENSE
build-type: Simple
extra-source-files:
@ -78,6 +78,7 @@ library
, wai-cors
, wai-extra
, warp-tls
, zcash-haskell
default-language: Haskell2010
executable zgo-backend-exe
@ -175,10 +176,13 @@ test-suite zgo-backend-test
, hspec-wai
, http-conduit
, http-types
, megaparsec
, mongoDB
, scotty
, securemem
, text
, time
, uuid
, zcash-haskell
, zgo-backend
default-language: Haskell2010

View File

@ -6,6 +6,7 @@ dbUser = "zgo"
dbPassword = "zcashrules"
nodeUser = "zecwallet"
nodePassword = "rdsxlun6v4a"
confirmations = 100
port = 3000
tls = false
certificate = "/path/to/cert.pem"

View File

@ -6,6 +6,7 @@ dbUser = "zgo"
dbPassword = "zcashrules"
nodeUser = "zecwallet"
nodePassword = "rdsxlun6v4a"
confirmations = 100
port = 3000
tls = false
certificate = "/path/to/cert.pem"