Merge pull request 'Updated version of `borsh`' (#10) from dev19 into master

Reviewed-on: #10

.gitignore

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

.gitmodules

@@ -0,0 +1,4 @@
+[submodule "zcash-haskell"]
+	path = zcash-haskell
+	url = https://git.vergara.tech/Vergara_Tech/zcash-haskell
+	branch = milestone2

CHANGELOG.md

@@ -4,7 +4,178 @@ 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).
 
-## [Unreleased]
+## [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
+
+- `isUserValid` function
+- New middleware to validated requests come from an existing user
+- New endpoint for the language data of the login page
+- New `OwnerData` to represent informational values
+- New `OwnerSettings` to abstract configuration settings for owners
+
+### Changed
+
+- Modified API tests to use `session` parameter.
+- Modified `api/owner` endpoint to use a specific data structure to create new owners
+- Modified `api/owner` endpoint to use session as input
+
+## [1.4.1] - 2023-05-02
+
+### Fixed
+
+- Correct potential node errors when saving viewing keys
+
+## [1.4.0] - 2023-05-02
+
+### Added
+
+- New type for Pro sessions
+- New functions to save and read Pro sessions from DB
+- New function to turn off Pro session
+
+### Fixed
+
+- Handling of potential failures of RPC calls to `zcashd` ([#6](https://git.vergara.tech/Vergara_Tech/zgo-backend/issues/6)).
+
+## [1.3.0] - 2023-03-16
+
+### Added
+
+- New type to handle UI translation objects
+- New endpoints for API to get/set translation
+- Tests for translation endpoints
+- Formal parser of ZGo-related tokens in memos
+
+### Changed
+
+- Remove old code for PIN generation
+- Xero reference field to include the amount of ZEC received
+- Separate periodic tasks from API server
+- Zcash transaction monitoring changed to use memo parser
+
+### Fixed
+
+- Xero token generation for brand new users
+
+## [1.2.5] - 2023-02-01
+
+### Fixed
+
+- Replaced the PIN generation with the cryptographically-secure `crypto-rng`.
+
+## [1.2.4] - 2023-01-30
+
+### Changed
+
+- Enhance payments to account for early payments on active sessions.
+
+## [1.2.3] - 2023-01-27
+
+### Changed
+
+- Implement `BLAKE3` for PIN hashing.
+
+## [1.2.2] - 2023-01-25
+
+### Fixed
+
+- Corrected selection criteria for expiring owners query
+
+## [1.2.1] - 2023-01-24
+
+### Added
+
+- New configuration fields for SMTP
+
+### Fixed
+
+- Owner expiration query
+- Xero token expiration query
+
+## [1.2.0] - 2023-01-09
+
+### Added
+
+- New utility to refresh Xero tokens periodically.
+- New module for WooCommerce interaction.
+- New `/auth` endpoint to authenticate with the WooCommerce plugin and corresponding tests
+- New `/woopayment` endpoint to generate a new order from the WooCommerce plugin and corresponding tests
+- New `/wootoken` endpoint to generate a new token and query the token from the database.
+
+### Changed
+
+- Refactored code for requesting Xero tokens to make it reusable.
+- Changed API authentication to allow for endpoints that don't require an `Authorization` header to support the WooCommerce integration
+- Enhanced the on-chain order confirmation functionality to support WooCommerce integration and future integrations.
+
+## [1.1.1] - 2022-10-08
+
+### Changed
+
+- Refactored the `api/owner` POST endpoint.
+- Added logic to remove extra whitespace from viewing key strings
 
 ## [1.1.0] - 2022-10-01
 

COPYING

@@ -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.
-

LICENSE

@@ -1,178 +1,21 @@
-Copyright (c) 2022 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.

README.md

@@ -1,10 +1,13 @@
 # ZGo Back End
 
+[![Please don't upload to GitHub](https://nogithub.codeberg.page/badge.svg)](https://nogithub.codeberg.page)
+
 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

Setup.hs

@@ -1,2 +0,0 @@
-import Distribution.Simple
-main = defaultMain

app/Server.hs

@@ -1,9 +1,10 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module Main where
+module Server where
 
 import Config
-import Control.Concurrent (forkIO)
+
+--import Control.Concurrent (forkIO)
 import Database.MongoDB
 import Network.Wai.Handler.Warp (defaultSettings, setPort)
 import Network.Wai.Handler.WarpTLS (runTLS, tlsSettings)
@@ -30,12 +31,12 @@ main = do
   if j
     then putStrLn "Connected to MongoDB!"
     else fail "MongoDB connection failed!"
-  _ <- forkIO (setInterval 60 (checkZcashPrices pipe (c_dbName loadedConfig)))
-  _ <- forkIO (setInterval 75 (scanZcash loadedConfig pipe))
-  _ <- forkIO (setInterval 90 (scanPayments loadedConfig pipe))
-  _ <- forkIO (setInterval 60 (checkPayments pipe (c_dbName loadedConfig)))
-  _ <- forkIO (setInterval 60 (expireOwners pipe (c_dbName loadedConfig)))
-  _ <- forkIO (setInterval 60 (updateLogins pipe loadedConfig))
+  {-_ <- forkIO (setInterval 60 (checkZcashPrices pipe (c_dbName loadedConfig)))-}
+  {-_ <- forkIO (setInterval 75 (scanZcash loadedConfig pipe))-}
+  {-_ <- forkIO (setInterval 90 (scanPayments loadedConfig pipe))-}
+  {-_ <- forkIO (setInterval 60 (checkPayments pipe (c_dbName loadedConfig)))-}
+  {-_ <- forkIO (setInterval 60 (expireOwners pipe (c_dbName loadedConfig)))-}
+  {-_ <- forkIO (setInterval 60 (updateLogins pipe loadedConfig))-}
   let appRoutes = routes pipe loadedConfig
   case myTlsSettings of
     Nothing -> scotty (c_port loadedConfig) appRoutes

app/Tasks.hs

@@ -0,0 +1,34 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Tasks where
+
+import Config
+import Database.MongoDB
+import ZGoBackend
+
+main :: IO ()
+main = do
+  putStrLn "ZGo Recurring Tasks"
+  putStrLn "Reading config..."
+  loadedConfig <- loadZGoConfig "zgo.cfg"
+  pipe <- connect $ host (c_dbHost loadedConfig)
+  j <-
+    access
+      pipe
+      master
+      (c_dbName loadedConfig)
+      (auth (c_dbUser loadedConfig) (c_dbPassword loadedConfig))
+  if j
+    then do
+      putStrLn "Connected to MongoDB!"
+      checkZcashPrices pipe (c_dbName loadedConfig)
+      scanZcash' 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!"

app/TokenRefresh.hs

@@ -0,0 +1,35 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module TokenRefresh where
+
+import Config
+import Data.Time.Clock
+import Database.MongoDB
+import Xero
+
+main :: IO ()
+main = do
+  putStrLn "Reading config..."
+  now <- getCurrentTime
+  loadedConfig <- loadZGoConfig "zgo.cfg"
+  pipe <- connect $ host (c_dbHost loadedConfig)
+  let db = c_dbName loadedConfig
+  j <-
+    access
+      pipe
+      master
+      db
+      (auth (c_dbUser loadedConfig) (c_dbPassword loadedConfig))
+  if j
+    then putStrLn "Connected to MongoDB!"
+    else fail "MongoDB connection failed!"
+  credsData <- access pipe master db findXero
+  let creds = cast' . Doc =<< credsData
+  tokens <- access pipe master db (findExpiringTokens now)
+  if not (null tokens)
+    then do
+      let t = map (cast' . Doc) tokens
+      case creds of
+        Just c -> mapM_ (refreshToken pipe db c "" "") t
+        Nothing -> fail "No credentials"
+    else putStrLn "No tokens to refresh1"

cabal.project

@@ -0,0 +1,16 @@
+packages:
+  ./*.cabal
+  zcash-haskell/zcash-haskell.cabal
+
+with-compiler: ghc-9.6.5
+
+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
+

package.yaml

@@ -1,107 +0,0 @@
-name:                zgo-backend
-version:             1.1.0
-git:                 "https://gitlab.com/pitmutt/zgo-backend"
-license:             BOSL
-author:              "Rene Vergara"
-maintainer:          "rene@vergara.network"
-copyright:           "Copyright (c) 2022 Vergara Technologies LLC"
-
-extra-source-files:
-- README.md
-- CHANGELOG.md
-- zgo.cfg
-
-# Metadata used when publishing your package
-synopsis:            Haskell Back-end for the ZGo point-of-sale application
-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 GitLab at <https://gitlab.com/pitmutt/zgo-backend#readme>
-
-dependencies:
-- base >= 4.7 && < 5
-
-library:
-  source-dirs: src
-  dependencies:
-  - mongoDB
-  - time
-  - text
-  - unordered-containers
-  - bson
-  - aeson
-  - QuickCheck
-  - quickcheck-instances
-  - scotty
-  - http-conduit
-  - wai-extra
-  - http-types
-  - time
-  - securemem
-  - bytestring
-  - regex-base
-  - regex-compat
-  - array
-  - random
-  - vector
-  - wai-cors
-  - warp-tls
-  - hexstring
-  - configurator
-  - scientific
-  - jwt
-  - containers
-
-executables:
-  zgo-backend-exe:
-    main:                Main.hs
-    source-dirs:         app
-    ghc-options:
-    - -threaded
-    - -rtsopts
-    - -with-rtsopts=-N
-    - -Wall
-    dependencies:
-    - zgo-backend
-    - base
-    - scotty
-    - wai-extra
-    - securemem
-    - text
-    - aeson
-    - mongoDB
-    - http-types
-    - http-conduit
-    - time
-    - bytestring
-    - configurator
-    - warp-tls
-    - warp
-
-tests:
-  zgo-backend-test:
-    main:                Spec.hs
-    source-dirs:         test
-    ghc-options:
-    - -threaded
-    - -rtsopts
-    - -with-rtsopts=-N
-    - -main-is Spec
-    dependencies:
-    - zgo-backend
-    - hspec
-    - QuickCheck
-    - text
-    - aeson
-    - http-conduit
-    - http-types
-    - hspec-expectations-json
-    - bytestring
-    - mongoDB
-    - hspec-wai
-    - securemem
-    - time
-    - configurator
-    - scotty

src/Config.hs

@@ -6,6 +6,7 @@ import qualified Data.ByteString as BS
 import Data.Configurator
 import Data.SecureMem
 import qualified Data.Text as T
+import Network.Socket (PortNumber)
 
 data Config =
   Config
@@ -21,6 +22,11 @@ data Config =
     , c_useTls :: Bool
     , c_certificate :: String
     , c_key :: String
+    , c_smtpHost :: String
+    , c_smtpPort :: Integer
+    , c_smtpUser :: String
+    , c_smtpPwd :: String
+    , c_confirmations :: Integer
     }
   deriving (Eq, Show)
 
@@ -39,6 +45,11 @@ loadZGoConfig path = do
   useTls <- require config "tls"
   cert <- require config "certificate"
   key <- require config "key"
+  mailHost <- require config "smtpHost"
+  mailPort <- require config "smtpPort"
+  mailUser <- require config "smtpUser"
+  mailPwd <- require config "smtpPwd"
+  conf <- require config "confirmations"
   return $
     Config
       dbHost
@@ -53,3 +64,8 @@ loadZGoConfig path = do
       useTls
       cert
       key
+      mailHost
+      mailPort
+      mailUser
+      mailPwd
+      conf

src/Item.hs

@@ -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

src/LangComponent.hs

@@ -0,0 +1,91 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module LangComponent where
+
+import Data.Aeson
+import Data.Aeson.KeyMap
+import qualified Data.Bson as B
+import Data.ByteString.Builder.Extra (AllocationStrategy)
+import Data.Maybe
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.Encoding as TLE
+import Database.MongoDB
+import Xero (Xero(x_clientId))
+
+-- | Type to represent a UI components text variables in different languages
+data LangComponent =
+  LangComponent
+    { lc_id :: Maybe ObjectId
+    , lc_lang :: T.Text
+    , lc_component :: T.Text
+    , lc_data :: Data.Aeson.Object
+    }
+  deriving (Show, Eq)
+
+instance ToJSON LangComponent where
+  toJSON (LangComponent i l c d) =
+    case i of
+      Just oid ->
+        object
+          ["_id" .= show oid, "language" .= l, "component" .= c, "data" .= d]
+      Nothing ->
+        object
+          [ "_id" .= ("" :: String)
+          , "language" .= l
+          , "component" .= c
+          , "data" .= d
+          ]
+
+instance FromJSON LangComponent where
+  parseJSON =
+    withObject "LangComponent" $ \obj -> do
+      l <- obj .: "language"
+      c <- obj .: "component"
+      d <- obj .: "data"
+      pure $ LangComponent Nothing l c d
+
+instance Val LangComponent where
+  val (LangComponent i l c d) =
+    if isJust i
+      then Doc
+             [ "_id" =: i
+             , "language" =: l
+             , "component" =: c
+             , "data" =: (TL.toStrict . TLE.decodeUtf8 . encode) d
+             ]
+      else Doc
+             [ "language" =: l
+             , "component" =: c
+             , "data" =: (TL.toStrict . TLE.decodeUtf8 . encode) d
+             ]
+  cast' (Doc d) = do
+    i <- B.lookup "_id" d
+    l <- B.lookup "language" d
+    c <- B.lookup "component" d
+    dt <- B.lookup "data" d
+    pure $
+      LangComponent
+        i
+        l
+        c
+        (fromMaybe
+           Data.Aeson.KeyMap.empty
+           ((decode . TLE.encodeUtf8 . TL.fromStrict) dt))
+
+-- Database Actions
+findLangComponent :: T.Text -> T.Text -> Action IO (Maybe Document)
+findLangComponent lang component =
+  findOne (select ["language" =: lang, "component" =: component] "langcomps")
+
+loadLangComponent :: LangComponent -> Action IO ()
+loadLangComponent lc = do
+  let langComp = val lc
+  case langComp of
+    Doc x ->
+      upsert
+        (select
+           ["language" =: lc_lang lc, "component" =: lc_component lc]
+           "langcomps")
+        x
+    _ -> error "Couldn't parse language JSON"

src/Order.hs

@@ -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,26 +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 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)
@@ -209,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")
@@ -248,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)

src/Owner.hs

@@ -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,8 +279,143 @@ 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)
+
+instance FromJSON OwnerData where
+  parseJSON =
+    withObject "OwnerData" $ \obj -> do
+      f <- obj .: "first"
+      l <- obj .: "last"
+      n <- obj .: "name"
+      s <- obj .: "street"
+      c <- obj .: "city"
+      st <- obj .: "state"
+      p <- obj .: "postal"
+      co <- obj .: "country"
+      e <- obj .: "email"
+      w <- obj .: "website"
+      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
+  , os_tips :: Bool
+  } deriving (Eq, Show, Generic)
+
+instance FromJSON OwnerSettings where
+  parseJSON =
+    withObject "OwnerSettings" $ \obj -> do
+      i <- obj .:? "_id"
+      a <- obj .: "address"
+      n <- obj .: "name"
+      c <- obj .: "currency"
+      t <- obj .: "tax"
+      tV <- obj .: "taxValue"
+      v <- obj .: "vat"
+      vV <- obj .: "vatValue"
+      p <- obj .: "paid"
+      z <- obj .: "zats"
+      inv <- obj .: "invoices"
+      e <- obj .: "expiration"
+      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
+          oT
+
+instance ToJSON OwnerSettings where
+  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
+      , "name" .= n
+      , "currency" .= c
+      , "tax" .= t
+      , "taxValue" .= tV
+      , "vat" .= v
+      , "vatValue" .= vV
+      , "paid" .= p
+      , "zats" .= z
+      , "invoices" .= inv
+      , "expiration" .= e
+      , "payconf" .= pc
+      , "crmToken" .= cT
+      , "viewkey" .= keyObfuscate vK
+      , "tips" .= oT
+      ]
+    where
+      keyObfuscate s
+        | s == "" = ""
+        | otherwise = T.take 8 s <> "...." <> T.takeEnd 8 s
+
+-- Helper Functions
+getOwnerSettings :: Owner -> OwnerSettings
+getOwnerSettings o =
+  OwnerSettings
+    (o_id o)
+    (oaddress o)
+    (oname o)
+    (ocurrency o)
+    (otax o)
+    (otaxValue o)
+    (ovat o)
+    (ovatValue o)
+    (opaid o)
+    (ozats o)
+    (oinvoices o)
+    (oexpiration o)
+    (opayconf o)
+    (ocrmToken o)
+    (oviewkey o)
+    (otips o)
+
 -- Database actions
 -- | Function to upsert an Owner
 upsertOwner :: Owner -> Action IO ()
@@ -292,3 +433,100 @@ findOwner zaddy = findOne (select ["address" =: zaddy] "owners")
 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 =
+  rest =<<
+  find
+    (select
+       ["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]]
+
+updateOwnerSettings :: OwnerSettings -> Action IO ()
+updateOwnerSettings os =
+  modify
+    (select ["_id" =: os_id os] "owners")
+    [ "$set" =:
+      [ "name" =: os_name os
+      , "currency" =: os_currency os
+      , "tax" =: os_tax os
+      , "taxValue" =: os_taxValue os
+      , "vat" =: os_vat os
+      , "vatValue" =: os_vatValue 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)
+
+instance Val ZGoProSession where
+  cast' (Doc d) = do
+    i <- B.lookup "_id" d
+    a <- B.lookup "address" d
+    e <- B.lookup "expiration" d
+    p <- B.lookup "closed" d
+    Just (ZGoProSession i a e p)
+  cast' _ = Nothing
+  val (ZGoProSession i a e p) =
+    case i of
+      Just oid ->
+        Doc ["_id" =: oid, "address" =: a, "expiration" =: e, "closed" =: p]
+      Nothing -> Doc ["address" =: a, "expiration" =: e, "closed" =: p]
+
+-- | Function to get a pro session
+findProSession :: T.Text -> Action IO (Maybe Document)
+findProSession zaddy =
+  findOne (select ["address" =: zaddy, "closed" =: False] "prosessions")
+
+-- | Function to get expiring pro sessions
+findExpiringProSessions :: UTCTime -> Action IO [Document]
+findExpiringProSessions now =
+  rest =<<
+  find
+    (select ["closed" =: False, "expiration" =: ["$lte" =: now]] "prosessions")
+
+-- | Function to upsert a pro session
+upsertProSession :: ZGoProSession -> Action IO ()
+upsertProSession ps = do
+  let prosession = val ps
+  case prosession of
+    Doc d ->
+      upsert
+        (select
+           ["address" =: psaddress ps, "expiration" =: psexpiration ps]
+           "prosessions")
+        d
+    _ -> return ()
+
+closeProSession :: ZGoProSession -> Action IO ()
+closeProSession ps = do
+  let prosession = val ps
+  case prosession of
+    Doc d -> modify (select d "prosessions") ["$set" =: ["closed" =: True]]
+    _ -> return ()

src/User.hs

@@ -6,6 +6,8 @@ module User where
 
 import Control.Monad
 import Control.Monad.IO.Class
+import Crypto.RNG
+import Crypto.RNG.Utils
 import Data.Aeson
 import qualified Data.Bson as B
 import Data.Maybe
@@ -67,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
@@ -82,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")
@@ -92,6 +127,16 @@ isUserNew p db tx =
   isNothing <$>
   access p master db (findOne (select ["session" =: session tx] "users"))
 
+-- | Function to verify if the given session has a valid user
+isUserValid :: Pipe -> T.Text -> T.Text -> IO Bool
+isUserValid p db s =
+  isJust <$>
+  access
+    p
+    master
+    db
+    (findOne (select ["session" =: s, "validated" =: True] "users"))
+
 -- | Function to mark user as validated
 validateUser :: T.Text -> Action IO ()
 validateUser session =
@@ -99,16 +144,8 @@ validateUser session =
     (select ["session" =: session] "users")
     ["$set" =: ["validated" =: True]]
 
-generatePin :: Int -> IO T.Text
-generatePin s = do
-  let g = mkStdGen s
-  pure $
-    T.pack (padLeft (show . head $ randomRs (1 :: Integer, 10000000) g) '0' 7)
-
--- | Helper function to pad a string to a given length
-padLeft :: String -> Char -> Int -> String
-padLeft s c m =
-  let isBaseLarger = length s > m
-      padder st ch m False = [ch | _ <- [1 .. (m - length st)]] ++ s
-      padder st _ _ True = st
-   in padder s c m isBaseLarger
+generatePin :: IO String
+generatePin = do
+  rngState <- newCryptoRNGState
+  runCryptoRNGT rngState $
+    randomString 7 ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9']

src/WooCommerce.hs

@@ -0,0 +1,119 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module WooCommerce where
+
+import qualified BLAKE3 as BLK
+import Data.Aeson
+import qualified Data.Bson as B
+import qualified Data.ByteArray as BA
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Base64 as B64
+import qualified Data.ByteString.Char8 as C
+import Data.Maybe
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as E
+import Data.Text.Encoding.Error (lenientDecode)
+import Database.MongoDB
+import Network.HTTP.Simple
+import Network.HTTP.Types.Status
+import Owner
+
+-- | Type to represent the WooCommerce token
+data WooToken =
+  WooToken
+    { w_id :: Maybe ObjectId
+    , w_owner :: ObjectId
+    , w_token :: T.Text
+    , w_url :: Maybe T.Text
+    }
+  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
+      then Doc ["_id" =: i, "owner" =: o, "token" =: t, "url" =: u]
+      else Doc ["owner" =: o, "token" =: t, "url" =: u]
+  cast' (Doc d) = do
+    i <- B.lookup "_id" d
+    o <- B.lookup "owner" d
+    t <- B.lookup "token" d
+    u <- B.lookup "url" d
+    Just
+      (WooToken
+         i
+         o
+         t
+         (E.decodeUtf8With lenientDecode . B64.decodeLenient . C.pack <$> u))
+  cast' _ = Nothing
+
+-- Database actions
+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 =
+  modify (select ["_id" =: w_id t] "wootokens") ["$set" =: ["url" =: u]]
+
+payWooOrder ::
+     String -- url
+  -> BS.ByteString -- WooCommerce order ID
+  -> BS.ByteString -- ZGo order id
+  -> BS.ByteString -- ZGo token
+  -> BS.ByteString -- Zcash price
+  -> BS.ByteString -- Total ZEC for order
+  -> IO ()
+payWooOrder u i o t p z = do
+  wooReq <- parseRequest u
+  let req =
+        setRequestPath "/wp-json/wc/v3/zgocallback" $
+        setRequestQueryString
+          [ ("token", Just t)
+          , ("orderid", Just o)
+          , ("wc_orderid", Just i)
+          , ("rate", Just p)
+          , ("totalzec", Just z)
+          ]
+          wooReq
+  print req
+  res <- httpLBS req
+  if getResponseStatus res == ok200
+    then return ()
+    else do
+      print $ getResponseStatus res
+      error "Failed to report payment to WooCommerce"
+
+generateWooToken :: Owner -> String -> Action IO ()
+generateWooToken o s =
+  case o_id o of
+    Just ownerid -> do
+      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"
+    Nothing -> error "Bad owner id"

src/Xero.hs

@@ -30,8 +30,7 @@ data Xero =
   deriving (Eq, Show)
 
 instance ToJSON Xero where
-  toJSON (Xero i cI s) =
-    object ["_id" .= show i, "clientId" .= cI, "clientSecret" .= s]
+  toJSON (Xero i cI s) = object ["_id" .= show i, "clientId" .= cI]
 
 instance Val Xero where
   val (Xero i cI s) = Doc ["_id" =: i, "clientId" =: cI, "clientSecret" =: s]
@@ -172,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
@@ -280,17 +299,24 @@ upsertToken t = do
 findToken :: T.Text -> Action IO (Maybe Document)
 findToken a = findOne (select ["address" =: a] "xerotokens")
 
+findExpiringTokens :: UTCTime -> Action IO [Document]
+findExpiringTokens now =
+  rest =<<
+  find (select ["refExpires" =: ["$lte" =: addUTCTime 172800 now]] "xerotokens")
+
 -- | Function to request accesstoken
 requestXeroToken :: Pipe -> T.Text -> Xero -> T.Text -> T.Text -> IO Bool
 requestXeroToken pipe dbName cred code address = do
   token <- access pipe master dbName $ findToken address
+  let oToken = token >>= cast' . Doc
+  refreshToken pipe dbName cred code address oToken
+
+refreshToken ::
+     Pipe -> T.Text -> Xero -> T.Text -> T.Text -> Maybe XeroToken -> IO Bool
+refreshToken pipe dbName cred code address token = do
   let pars =
         case token of
-          Just xT -> do
-            let xToken = cast' (Doc xT) :: Maybe XeroToken
-            case xToken of
-              Nothing -> error "Failed to parse XeroToken BSON"
-              Just x -> "grant_type=refresh_token&refresh_token=" <> t_refresh x
+          Just x -> "grant_type=refresh_token&refresh_token=" <> t_refresh x
           Nothing ->
             "grant_type=authorization_code&code=" <>
             code <> "&redirect_uri=http://localhost:4200/xeroauth"
@@ -309,8 +335,13 @@ requestXeroToken pipe dbName cred code address = do
   case rCode of
     200 -> do
       let newToken = getResponseBody (res :: Response XeroToken)
-      let accCode = t_code <$> (token >>= cast' . Doc)
-      pToken <- processToken newToken address (fromMaybe "" accCode)
+      let accCode = t_code <$> token
+      {-let address = t_address <$> token-}
+      pToken <-
+        processToken
+          newToken
+          (maybe address t_address token)
+          (fromMaybe "" accCode)
       --print pToken
       _ <- access pipe master dbName $ upsertToken pToken
       _ <- getTenantId pipe dbName pToken
@@ -402,8 +433,9 @@ getXeroInvoice pipe dbName inv address = do
                 Right iData -> return $ Just (head $ xir_invs iData)
             _ -> return Nothing
 
-payXeroInvoice :: Pipe -> T.Text -> T.Text -> T.Text -> Double -> IO ()
-payXeroInvoice pipe dbName inv address amt = do
+payXeroInvoice ::
+     Pipe -> T.Text -> T.Text -> T.Text -> Double -> Double -> IO ()
+payXeroInvoice pipe dbName inv address amt zec = do
   token <- access pipe master dbName $ findToken address
   let aToken = t_access <$> (token >>= cast' . Doc)
   let aCode = t_code <$> (token >>= cast' . Doc)
@@ -418,7 +450,8 @@ payXeroInvoice pipe dbName inv address amt = do
                  [ "Invoice" .= object ["InvoiceNumber" .= inv]
                  , "Account" .= object ["Code" .= fromMaybe "" aCode]
                  , "Date" .= utctDay today
-                 , "Reference" .= ("Paid in Zcash through ZGo" :: String)
+                 , "Reference" .=
+                   ("Paid in Zcash through ZGo: " ++ show zec ++ " ZEC" :: String)
                  , "Amount" .= amt
                  ]) $
             addRequestHeader "Accept" "application/json" $
@@ -429,6 +462,7 @@ payXeroInvoice pipe dbName inv address amt = do
             setRequestPath "/api.xro/2.0/Payments" $
             setRequestHost "api.xero.com" $
             setRequestMethod "PUT" defaultRequest
-      res <- httpJSON req
-      print (res :: Response Object)
+      res <- httpJSON req :: IO (Response Object)
+      print res
+      return ()
     else error "Invalid parameters"

src/ZGoTx.hs

@@ -6,23 +6,30 @@ module ZGoTx where
 
 import Data.Aeson
 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
@@ -92,3 +99,124 @@ instance Val ZGoTx where
           , "txid" =: t
           , "memo" =: m
           ]
+
+-- | Type to represent and parse ZGo memos
+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
+  string "ZGO"
+  pay <- optional $ char 'p'
+  string "::"
+  s <- some $ hexDigitChar <|> char '-'
+  let u = U.fromString s
+  case u of
+    Nothing -> fail "Invalid UUID"
+    Just u' -> do
+      if isJust pay
+        then pure $ PayMsg u'
+        else pure $ Login u'
+
+pSaplingAddress :: Parser MemoToken
+pSaplingAddress = do
+  string "zs"
+  a <- some alphaNumChar
+  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 <-
+    some
+      (alphaNumChar <|> punctuationChar <|> symbolChar <|>
+       charCategory OtherSymbol)
+  pure $ Msg . T.pack $ msg
+
+pMemo :: Parser MemoToken
+pMemo = do
+  optional $ some spaceChar
+  t <- pSession <|> pSaplingAddress <|> pUnifiedAddress <|> pOrderId <|> pMsg
+  optional $ some spaceChar
+  return t
+
+isMemoToken :: T.Text -> MemoToken -> Bool
+isMemoToken kind t =
+  case kind of
+    "session" ->
+      case t of
+        PayMsg i -> True
+        Login j -> True
+        _ -> False
+    "address" ->
+      case t of
+        Address a -> True
+        _ -> False
+    "payment" ->
+      case t of
+        PayMsg i -> True
+        _ -> False
+    _ -> False
+
+pZGoMemo :: Parser ZGoMemo
+pZGoMemo = do
+  tks <- some pMemo
+  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) &&
+      case head tks of
+        PayMsg x -> True
+        _ -> isPayment $ tail tks
+    isAddress [] = Nothing
+    isAddress tks =
+      if not (null tks)
+        then case head tks of
+               Address x -> Just x
+               _ -> isAddress $ tail tks
+        else Nothing
+    isSession [] = Nothing
+    isSession tks =
+      if not (null tks)
+        then case head tks of
+               Login x -> Just x
+               PayMsg y -> Just y
+               _ -> isSession $ tail tks
+        else Nothing

stack.yaml

@@ -1,69 +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:
-  url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/4.yaml
-
-# 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:
-- .
-# 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://github.com/reach-sh/haskell-hexstring.git
-    commit: 085c16fb21b9f856a435a3faab980e7e0b319341
-# 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]
-# extra-lib-dirs: [/path/to/dir]
-#
-# Allow a newer minor version of GHC than the snapshot specifies
-# compiler-check: newer-minor

stack.yaml.lock

@@ -1,24 +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:
-    name: hexstring
-    version: 0.11.1
-    git: https://github.com/reach-sh/haskell-hexstring.git
-    pantry-tree:
-      size: 687
-      sha256: 9ecf67856f59dfb382b283eceb42e4fc1865935d1a7e59111556ed381c6a2ffd
-    commit: 085c16fb21b9f856a435a3faab980e7e0b319341
-  original:
-    git: https://github.com/reach-sh/haskell-hexstring.git
-    commit: 085c16fb21b9f856a435a3faab980e7e0b319341
-snapshots:
-- completed:
-    size: 618683
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/4.yaml
-    sha256: d4ee004c46ba878d2f304f5d748d493057be579192a8d148527f3ba55c9df57f
-  original:
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/4.yaml

zcash-haskell

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

zgo-backend.cabal

@@ -1,18 +1,18 @@
-cabal-version: 1.12
+cabal-version: 3.0
 
--- This file has been generated from package.yaml by hpack version 0.34.4.
+-- 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.0.0
+version:        1.9.0
 synopsis:       Haskell Back-end for the ZGo point-of-sale application
-description:    Please see the README on GitLab at <https://gitlab.com/pitmutt/zgo-backend#readme>
+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) 2022 Vergara Technologies LLC
-license:        BOSL
+copyright:      2022-2024 Vergara Technologies LLC
+license:        MIT
 license-file:   LICENSE
 build-type:     Simple
 extra-source-files:
@@ -20,23 +20,19 @@ extra-source-files:
     CHANGELOG.md
     zgo.cfg
 
-source-repository head
-  type: git
-  location: https://gitlab.com/pitmutt/zgo-backend
-
 library
   exposed-modules:
       Config
       Item
+      LangComponent
       Order
       Owner
       Payment
       User
+      WooCommerce
       Xero
       ZGoBackend
       ZGoTx
-  other-modules:
-      Paths_zgo_backend
   hs-source-dirs:
       src
   build-depends:
@@ -44,15 +40,22 @@ library
     , aeson
     , array
     , base >=4.7 && <5
+    , base64-bytestring
+    , blake3
     , bson
     , bytestring
     , configurator
     , containers
+    , crypto-rng
+    , ghc-prim
     , hexstring
     , http-conduit
     , http-types
     , jwt
+    , megaparsec
+    , memory
     , mongoDB
+    , network
     , quickcheck-instances
     , random
     , regex-base
@@ -63,19 +66,22 @@ library
     , text
     , time
     , unordered-containers
+    , uuid
     , vector
+    , wai
     , wai-cors
     , wai-extra
     , warp-tls
+    , zcash-haskell
   default-language: Haskell2010
 
 executable zgo-backend-exe
-  main-is: Main.hs
-  other-modules:
-      Paths_zgo_backend
+  main-is: Server.hs
   hs-source-dirs:
       app
-  ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall
+  ghc-options: -main-is Server -threaded -rtsopts -with-rtsopts=-N -Wall
+  pkgconfig-depends:
+      rustzcash_wrapper
   build-depends:
       aeson
     , base
@@ -83,6 +89,51 @@ executable zgo-backend-exe
     , configurator
     , http-conduit
     , http-types
+    , megaparsec
+    , mongoDB >=2.7.1.4
+    , scotty
+    , securemem
+    , text
+    , time
+    , wai-extra
+    , warp
+    , warp-tls
+    , zgo-backend
+  default-language: Haskell2010
+
+executable zgo-tasks
+  main-is: Tasks.hs
+  hs-source-dirs:
+      app
+  ghc-options: -main-is Tasks -threaded -rtsopts -with-rtsopts=-N -Wall
+  pkgconfig-depends:
+      rustzcash_wrapper
+  build-depends:
+      base
+    , megaparsec
+    , mongoDB
+    , scotty
+    , time
+    , warp
+    , warp-tls
+    , zgo-backend
+  default-language: Haskell2010
+
+executable zgo-token-refresh
+  main-is: TokenRefresh.hs
+  hs-source-dirs:
+      app
+  ghc-options: -main-is TokenRefresh -threaded -rtsopts -with-rtsopts=-N -Wall
+  pkgconfig-depends:
+      rustzcash_wrapper
+  build-depends:
+      aeson
+    , base
+    , bytestring
+    , configurator
+    , http-conduit
+    , http-types
+    , megaparsec
     , mongoDB
     , scotty
     , securemem
@@ -97,11 +148,11 @@ executable zgo-backend-exe
 test-suite zgo-backend-test
   type: exitcode-stdio-1.0
   main-is: Spec.hs
-  other-modules:
-      Paths_zgo_backend
   hs-source-dirs:
       test
   ghc-options: -threaded -rtsopts -with-rtsopts=-N -main-is Spec
+  pkgconfig-depends:
+      rustzcash_wrapper
   build-depends:
       QuickCheck
     , aeson
@@ -112,11 +163,15 @@ test-suite zgo-backend-test
     , hspec-expectations-json
     , hspec-wai
     , http-conduit
+    , HUnit
     , http-types
+    , megaparsec
     , mongoDB
     , scotty
     , securemem
     , text
     , time
+    , uuid
+    , zcash-haskell
     , zgo-backend
   default-language: Haskell2010

zgo.cfg

@@ -6,7 +6,12 @@ dbUser = "zgo"
 dbPassword = "zcashrules"
 nodeUser = "zecwallet"
 nodePassword = "rdsxlun6v4a"
+confirmations = 100
 port = 3000
 tls = false
 certificate = "/path/to/cert.pem"
 key = "/path/to/key.pem"
+smtpHost = "127.0.0.1"
+smtpPort = 1025
+smtpUser = "contact@zgo.cash"
+smtpPwd = "uib3K8BkCPexl_wr5bYfrg"

zgotest.cfg

@@ -6,7 +6,12 @@ dbUser = "zgo"
 dbPassword = "zcashrules"
 nodeUser = "zecwallet"
 nodePassword = "rdsxlun6v4a"
+confirmations = 100
 port = 3000
 tls = false
 certificate = "/path/to/cert.pem"
 key = "/path/to/key.pem"
+smtpHost = "127.0.0.1"
+smtpPort = 1025
+smtpUser = "contact@zgo.cash"
+smtpPwd = "uib3K8BkCPexl_wr5bYfrg"