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

Reviewed-on: https://git.vergara.tech/Vergara_Tech/zgo-backend/pulls/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,6 +4,35 @@ 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.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

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

app/Tasks.hs

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

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,167 +0,0 @@
-name:                zgo-backend
-version:             1.7.0
-git:                 "https://git.vergara.tech/Vergara_Tech/zgo-backend"
-license:             BOSL
-author:              "Rene Vergara"
-maintainer:          "rene@vergara.network"
-copyright:           "Copyright (c) 2023 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 at <https://git.vergara.tech/Vergara_Tech//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
-  - base64-bytestring
-  - wai
-  - blake3
-  - memory
-  - ghc-prim
-  - network
-  - crypto-rng
-  - megaparsec
-  - uuid
-  - zcash-haskell
-
-executables:
-  zgo-backend-exe:
-    main:                Server.hs
-    source-dirs:         app
-    ghc-options:
-            - -main-is Server
-            - -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
-            - megaparsec
-  zgo-token-refresh:
-    main:                TokenRefresh.hs
-    source-dirs:         app
-    ghc-options:
-            - -main-is TokenRefresh
-            - -threaded
-            - -rtsopts
-            - -with-rtsopts=-N
-            - -Wall
-    dependencies:
-            - base
-            - zgo-backend
-            - base
-            - scotty
-            - wai-extra
-            - securemem
-            - text
-            - aeson
-            - mongoDB
-            - http-types
-            - http-conduit
-            - time
-            - bytestring
-            - configurator
-            - warp-tls
-            - warp
-            - megaparsec
-  zgo-tasks:
-    main:                Tasks.hs
-    source-dirs:         app
-    ghc-options:
-            - -main-is Tasks
-            - -threaded
-            - -rtsopts
-            - -with-rtsopts=-N
-            - -Wall
-    dependencies:
-            - base
-            - mongoDB
-            - zgo-backend
-            - scotty
-            - warp-tls
-            - warp
-            - time
-            - megaparsec
-
-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
-    - megaparsec
-    - uuid
-    - zcash-haskell

src/Order.hs

@@ -12,29 +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
-    , qtoken :: 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 tk) =
+  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
@@ -52,6 +54,9 @@ instance ToJSON ZGoOrder where
           , "externalInvoice" .= eI
           , "shortCode" .= sC
           , "token" .= tk
+          , "taxAmount" .= qT
+          , "vatAmount" .= qV
+          , "tipAmount" .= tip
           ]
       Nothing ->
         object
@@ -69,6 +74,9 @@ instance ToJSON ZGoOrder where
           , "externalInvoice" .= eI
           , "shortCode" .= sC
           , "token" .= tk
+          , "taxAmount" .= qT
+          , "vatAmount" .= qV
+          , "tipAmount" .= tip
           ]
 
 instance FromJSON ZGoOrder where
@@ -88,10 +96,13 @@ instance FromJSON ZGoOrder where
       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
@@ -106,9 +117,12 @@ instance FromJSON ZGoOrder where
           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 tk) =
+  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
@@ -125,6 +139,9 @@ instance Val ZGoOrder where
              , "externalInvoice" =: eI
              , "shortCode" =: sC
              , "token" =: tk
+             , "taxAmount" =: qT
+             , "vatAmount" =: qV
+             , "tipAmount" =: tip
              ]
       else Doc
              [ "address" =: a
@@ -140,6 +157,9 @@ instance Val ZGoOrder where
              , "externalInvoice" =: eI
              , "shortCode" =: sC
              , "token" =: tk
+             , "taxAmount" =: qT
+             , "vatAmount" =: qV
+             , "tipAmount" =: tip
              ]
   cast' (Doc d) = do
     i <- B.lookup "_id" d
@@ -156,17 +176,18 @@ instance Val ZGoOrder where
     eI <- B.lookup "externalInvoice" d
     sC <- B.lookup "shortCode" d
     tk <- B.lookup "token" d
-    Just (ZGoOrder i a s ts c cur p t tZ l pd eI sC tk)
+    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]
@@ -189,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)
@@ -224,36 +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) =
-  ZGoOrder i a s ts c cur p t tZ l pd eI sC token
+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")
@@ -268,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,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
@@ -367,6 +388,7 @@ instance ToJSON OwnerSettings where
       , "payconf" .= pc
       , "crmToken" .= cT
       , "viewkey" .= keyObfuscate vK
+      , "tips" .= oT
       ]
     where
       keyObfuscate s
@@ -392,6 +414,7 @@ getOwnerSettings o =
     (opayconf o)
     (ocrmToken o)
     (oviewkey o)
+    (otips o)
 
 -- Database actions
 -- | Function to upsert an Owner
@@ -424,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]]
@@ -442,6 +469,7 @@ updateOwnerSettings os =
       , "zats" =: os_zats os
       , "payconf" =: os_payconf os
       , "crmToken" =: os_crmToken os
+      , "tips" =: os_tips os
       ]
     ]
 
@@ -450,14 +478,12 @@ 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

src/ZGoTx.hs

@@ -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,19 +101,19 @@ 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
@@ -135,9 +136,23 @@ 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
@@ -150,7 +165,7 @@ pMsg = do
 pMemo :: Parser MemoToken
 pMemo = do
   optional $ some spaceChar
-  t <- pSession <|> pSaplingAddress <|> pMsg
+  t <- pSession <|> pSaplingAddress <|> pUnifiedAddress <|> pOrderId <|> pMsg
   optional $ some spaceChar
   return t
 
@@ -175,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) &&

stack.yaml

@@ -1,81 +0,0 @@
-# This file was automatically generated by 'stack init'
-#
-# Some commonly used options have been documented as comments in this file.
-# For advanced use and comprehensive documentation of the format, please see:
-# https://docs.haskellstack.org/en/stable/yaml_configuration/
-
-# Resolver to choose a 'specific' stackage snapshot or a compiler version.
-# A snapshot resolver dictates the compiler version and the set of packages
-# to be used for project dependencies. For example:
-#
-# resolver: lts-3.5
-# resolver: nightly-2015-09-21
-# resolver: ghc-7.10.2
-#
-# The location of a snapshot can be provided as a file or url. Stack assumes
-# a snapshot provided as a file might change, whereas a url resource does not.
-#
-# resolver: ./custom-snapshot.yaml
-# resolver: https://example.com/snapshots/2018-01-01.yaml
-resolver: lts-20.23
-  #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
-  - git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
-    commit: fef3d3af35a09db718cddb8fc9166b2d2691a744
-  - git: https://git.vergara.tech/Vergara_Tech/haskell-foreign-rust.git
-    commit: 787c2e813eb3a5d16c375d4b37dfefbd2adcdf05
-  - git: https://github.com/well-typed/borsh.git
-    commit: d2fcfa159e0a844b1ec5e8ed3e232d4b380fa831
-  - 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
-# 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,98 +0,0 @@
-# This file was autogenerated by Stack.
-# You should not edit this file by hand.
-# For more information, please see the documentation at:
-#   https://docs.haskellstack.org/en/stable/lock_files
-
-packages:
-- completed:
-    commit: 085c16fb21b9f856a435a3faab980e7e0b319341
-    git: https://github.com/reach-sh/haskell-hexstring.git
-    name: hexstring
-    pantry-tree:
-      sha256: 9ecf67856f59dfb382b283eceb42e4fc1865935d1a7e59111556ed381c6a2ffd
-      size: 687
-    version: 0.11.1
-  original:
-    commit: 085c16fb21b9f856a435a3faab980e7e0b319341
-    git: https://github.com/reach-sh/haskell-hexstring.git
-- completed:
-    commit: fef3d3af35a09db718cddb8fc9166b2d2691a744
-    git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
-    name: zcash-haskell
-    pantry-tree:
-      sha256: ec7782cf2646da17548d59af0ea98dcbaac1b6c2176258c696a7f508db6dbc21
-      size: 1126
-    version: 0.1.0
-  original:
-    commit: fef3d3af35a09db718cddb8fc9166b2d2691a744
-    git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
-- completed:
-    commit: 787c2e813eb3a5d16c375d4b37dfefbd2adcdf05
-    git: https://git.vergara.tech/Vergara_Tech/haskell-foreign-rust.git
-    name: foreign-rust
-    pantry-tree:
-      sha256: be2f6fc0fab58a90fec657bdb6bd0ccf0810c7dccfe95c78b85e174fae227e42
-      size: 2315
-    version: 0.1.0
-  original:
-    commit: 787c2e813eb3a5d16c375d4b37dfefbd2adcdf05
-    git: https://git.vergara.tech/Vergara_Tech/haskell-foreign-rust.git
-- completed:
-    commit: d2fcfa159e0a844b1ec5e8ed3e232d4b380fa831
-    git: https://github.com/well-typed/borsh.git
-    name: borsh
-    pantry-tree:
-      sha256: 8335925f495a5a653fcb74b6b8bb18cd0b6b7fe7099a1686108704e6ab82f47b
-      size: 2268
-    version: 0.3.0
-  original:
-    commit: d2fcfa159e0a844b1ec5e8ed3e232d4b380fa831
-    git: https://github.com/well-typed/borsh.git
-- completed:
-    hackage: 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:
-      sha256: 0264ef3e7919e7b0d668c4153f6ce0d88e6965626b52d9dfd2cafd70309501d3
-      size: 1433
-  original:
-    hackage: blake3-0.2@sha256:d1146b9a51ccfbb0532780778b6d016a614e3d44c05d8c1923dde9a8be869045,2448
-- completed:
-    hackage: crypto-rng-0.3.0.1@sha256:04f4ae75943ecad8b794950985054130f272d65a588b6b6528f56df0bfedc4dc,1565
-    pantry-tree:
-      sha256: 1caccafe35d1ae3063f057c31188742a8e794f4f4e4530bab4019c0a514ee54f
-      size: 455
-  original:
-    hackage: crypto-rng-0.3.0.1@sha256:04f4ae75943ecad8b794950985054130f272d65a588b6b6528f56df0bfedc4dc,1565
-snapshots:
-- completed:
-    sha256: 4c972e067bae16b95961dbfdd12e07f1ee6c8fffabbfa05c3d65100b03f548b7
-    size: 650253
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/23.yaml
-  original: lts-20.23

test/Spec.hs

@@ -28,6 +28,7 @@ import Order
 import Owner
 import Payment
 import System.IO.Unsafe
+import Test.HUnit hiding (assert)
 import Test.Hspec
 import Test.Hspec.Expectations.Json
 import Test.Hspec.QuickCheck
@@ -36,7 +37,7 @@ import Test.QuickCheck.Gen
 import Test.QuickCheck.Monadic
 import Text.Megaparsec
 import User
-import Web.Scotty
+import Web.Scotty hiding (getResponseStatus)
 import WooCommerce
 import Xero
 import ZGoBackend
@@ -56,10 +57,10 @@ main = do
       describe "hex strings" $ do
         prop "encoding and decoding are inverse" $ \x ->
           (decodeHexText . encodeHexText) x == x
-      describe "zToZGoTx" $
+      describe "Memo parsers" $
         --prop "memo parsing" testMemoParser
        do
-        it "parse ZecWallet memo" $ do
+        it "parse ZecWallet memo - Sapling" $ do
           let m =
                 runParser
                   pZGoMemo
@@ -70,7 +71,7 @@ main = do
             Right m' ->
               m_session m' `shouldBe`
               U.fromString "5d3d4494-51c0-432d-8495-050419957aea"
-        it "parse YWallet memo" $ do
+        it "parse YWallet memo - Sapling" $ do
           let m =
                 runParser
                   pZGoMemo
@@ -81,90 +82,53 @@ main = do
             Right m' ->
               m_session m' `shouldBe`
               U.fromString "ad8477d3-4fdd-4c97-90b2-76630b5f77e1"
-        it "converts ZecWallet tx to ZGo tx" $ do
-          let t =
-                ZcashTx
-                  "someId"
-                  0.5
-                  50000000
-                  1602000
-                  18732456
-                  False
-                  5
-                  "ZGO::5d3d4494-51c0-432d-8495-050419957aea\nReply-To:\nzs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
-          zToZGoTx t `shouldBe`
-            ZGoTx
-              Nothing
-              "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
-              "5d3d4494-51c0-432d-8495-050419957aea"
-              5
-              18732456
-              0.5
-              "someId"
-              "ZGO::5d3d4494-51c0-432d-8495-050419957aea\nReply-To:\nzs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
-        it "converts YWallet tx to ZGo tx" $ do
-          let t =
-                ZcashTx
-                  "someId"
-                  0.5
-                  50000000
-                  1602000
-                  18732456
-                  False
-                  5
-                  "\128737MSG\nzs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e\n\nZGO::ad8477d3-4fdd-4c97-90b2-76630b5f77e1"
-          zToZGoTx t `shouldBe`
-            ZGoTx
-              Nothing
-              "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
-              "ad8477d3-4fdd-4c97-90b2-76630b5f77e1"
-              5
-              18732456
-              0.5
-              "someId"
-              "\128737MSG\nzs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e\n\nZGO::ad8477d3-4fdd-4c97-90b2-76630b5f77e1"
-        it "converts ZecWallet payment tx to ZGo tx" $ do
-          let t =
-                ZcashTx
-                  "someId"
-                  0.5
-                  50000000
-                  1602000
-                  18732456
-                  False
-                  5
-                  "ZGOp::5d3d4494-51c0-432d-8495-050419957aea\nReply-To:\nzs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
-          zToZGoTx t `shouldBe`
-            ZGoTx
-              Nothing
-              ""
-              "5d3d4494-51c0-432d-8495-050419957aea"
-              5
-              18732456
-              0.5
-              "someId"
-              "ZGOp::5d3d4494-51c0-432d-8495-050419957aea\nReply-To:\nzs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
-        it "converts YWallet payment tx to ZGo tx" $ do
-          let t =
-                ZcashTx
-                  "someId"
-                  0.5
-                  50000000
-                  1602000
-                  18732456
-                  False
-                  5
-                  "\128737MSG\nzs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e\n\nZGOp::ad8477d3-4fdd-4c97-90b2-76630b5f77e1"
-          zToZGoTx t `shouldBe`
-            ZGoTx
-              Nothing
-              ""
-              "ad8477d3-4fdd-4c97-90b2-76630b5f77e1"
-              5
-              18732456
-              0.5
-              "someId"
-              "\128737MSG\nzs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e\n\nZGOp::ad8477d3-4fdd-4c97-90b2-76630b5f77e1"
+        it "parse Zingo memo - Sapling" $ do
+          let m =
+                runParser
+                  pZGoMemo
+                  "Zingo memo"
+                  "ZGO::5d3d4494-51c0-432d-8495-050419957aea\nReply to:\nzs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
+          case m of
+            Left e -> putStrLn $ errorBundlePretty e
+            Right m' ->
+              m_session m' `shouldBe`
+              U.fromString "5d3d4494-51c0-432d-8495-050419957aea"
+        it "parse ZecWallet memo - Orchard" $ do
+          let m =
+                runParser
+                  pZGoMemo
+                  "Zecwalllet memo"
+                  "ZGO::5d3d4494-51c0-432d-8495-050419957aea\nReply-To:\nu17n7hpwaujyq7ux8f9jpyymtnk5urw7pyrf60smp5mawy7jgz325hfvz3jn3zsfya8yxryf9q7ldk8nu8df0emra5wne28zq9d9nm2pu4x6qwjha565av9aze0xgujgslz74ufkj0c0cylqwjyrh9msjfh7jzal6d3qzrnhkkqy3pqm8j63y07jxj7txqeac982778rmt64f32aum94x"
+          case m of
+            Left e -> putStrLn $ errorBundlePretty e
+            Right m' ->
+              m_address m' `shouldBe`
+              Just
+                "u17n7hpwaujyq7ux8f9jpyymtnk5urw7pyrf60smp5mawy7jgz325hfvz3jn3zsfya8yxryf9q7ldk8nu8df0emra5wne28zq9d9nm2pu4x6qwjha565av9aze0xgujgslz74ufkj0c0cylqwjyrh9msjfh7jzal6d3qzrnhkkqy3pqm8j63y07jxj7txqeac982778rmt64f32aum94x"
+        it "parse YWallet memo - Orchard" $ do
+          let m =
+                runParser
+                  pZGoMemo
+                  "Ywallet memo"
+                  "\128737MSG\nu17n7hpwaujyq7ux8f9jpyymtnk5urw7pyrf60smp5mawy7jgz325hfvz3jn3zsfya8yxryf9q7ldk8nu8df0emra5wne28zq9d9nm2pu4x6qwjha565av9aze0xgujgslz74ufkj0c0cylqwjyrh9msjfh7jzal6d3qzrnhkkqy3pqm8j63y07jxj7txqeac982778rmt64f32aum94x\n\nZGO::ad8477d3-4fdd-4c97-90b2-76630b5f77e1"
+          case m of
+            Left e -> putStrLn $ errorBundlePretty e
+            Right m' ->
+              m_address m' `shouldBe`
+              Just
+                "u17n7hpwaujyq7ux8f9jpyymtnk5urw7pyrf60smp5mawy7jgz325hfvz3jn3zsfya8yxryf9q7ldk8nu8df0emra5wne28zq9d9nm2pu4x6qwjha565av9aze0xgujgslz74ufkj0c0cylqwjyrh9msjfh7jzal6d3qzrnhkkqy3pqm8j63y07jxj7txqeac982778rmt64f32aum94x"
+        it "parse Zingo memo - Orchard" $ do
+          let m =
+                runParser
+                  pZGoMemo
+                  "Zingo memo"
+                  "ZGO::5d3d4494-51c0-432d-8495-050419957aea\nReply to:\nu17n7hpwaujyq7ux8f9jpyymtnk5urw7pyrf60smp5mawy7jgz325hfvz3jn3zsfya8yxryf9q7ldk8nu8df0emra5wne28zq9d9nm2pu4x6qwjha565av9aze0xgujgslz74ufkj0c0cylqwjyrh9msjfh7jzal6d3qzrnhkkqy3pqm8j63y07jxj7txqeac982778rmt64f32aum94x"
+          case m of
+            Left e -> putStrLn $ errorBundlePretty e
+            Right m' ->
+              m_address m' `shouldBe`
+              Just
+                "u17n7hpwaujyq7ux8f9jpyymtnk5urw7pyrf60smp5mawy7jgz325hfvz3jn3zsfya8yxryf9q7ldk8nu8df0emra5wne28zq9d9nm2pu4x6qwjha565av9aze0xgujgslz74ufkj0c0cylqwjyrh9msjfh7jzal6d3qzrnhkkqy3pqm8j63y07jxj7txqeac982778rmt64f32aum94x"
       describe "PIN generator" $ do
         it "should give a 7 digit" $ do
           pin <- generatePin
@@ -206,7 +170,7 @@ main = do
             res <- httpLBS req
             getResponseStatus res `shouldBe` unauthorized401
         describe "blockheight endpoint" $ do
-          it "returns a block number" $ do
+          xit "returns a block number" $ do
             req <-
               testGet
                 "/blockheight"
@@ -335,7 +299,7 @@ main = do
           it "return owner by id" $ do
             req <-
               testGet
-                "/api/ownerid"
+                "/ownerid"
                 [ ("id", Just "627ad3492b05a76be3000001")
                 , ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")
                 ]
@@ -362,6 +326,9 @@ main = do
                     ""
                     ""
                     "testToken4321"
+                    0
+                    0
+                    0
             req <-
               testPostJson "/api/order" $
               A.object ["payload" A..= A.toJSON testOrder]
@@ -389,6 +356,9 @@ main = do
                     ""
                     ""
                     "testToken4321"
+                    0
+                    0
+                    0
             req <-
               testPostJson "/api/order" $
               A.object ["payload" A..= A.toJSON testOrder]
@@ -416,6 +386,9 @@ main = do
                     ""
                     ""
                     "testToken4321"
+                    0
+                    0
+                    0
             req <-
               testPostJson "/api/order" $
               A.object ["payload" A..= A.toJSON testOrder]
@@ -728,6 +701,8 @@ main = do
                 "zxviews1qdjagrrpqqqqpq8es75mlu6rref0qyrstchf8dxzeygtsejwfqu8ckhwl2qj5m8am7lmupxk3vkvdjm8pawjpmesjfapvsqw96pa46c2z0kk7letrxf7mkltwz54fwpxc7kc79mm5kce3rwn5ssl009zwsra2spppwgrx25s9k5hq65f69l4jz2tjmqgy0pl49qmtaj3nudk6wglwe2hpa327hydlchtyq9av6wjd6hu68e04ahwk9a9n2kt0kj3nj99nue65awtu5cwwcpjs"
           let vk2 =
                 "zxviews1qdjagrrpqqqqpq8es75mlufakef0qyrstchf8dxzeygtsejwfqu8ckhwl2qj5m8am7lmupxk3vkvdjm8pawjpmesjfapvsqw96pa46c2z0kk7letrxf7mkltwz54fwpxc7kc79mm5kce3rwn5ssl009zwsra2spppwgrx25s9k5hq65f69l4jz2tjmqgy0pl49qmtaj3nudk6wglwe2hpa327hydlchtyq9av6wjd6hu68e04ahwk9a9n2kt0kj3nj99nue65awtu5cwwcpjs"
+          let vk3 =
+                "uview1u833rp8yykd7h4druwht6xp6k8krle45fx8hqsw6vzw63n24atxpcatws82z092kryazuu6d7rayyut8m36wm4wpjy2z8r9hj48fx5pf49gw4sjrq8503qpz3vqj5hg0vg9vsqeasg5qjuyh94uyfm7v76udqcm2m0wfc25hcyqswcn56xxduq3xkgxkr0l73cjy88fdvf90eq5fda9g6x7yv7d0uckpevxg6540wc76xrc4axxvlt03ptaa2a0rektglmdy68656f3uzcdgqqyu0t7wk5cvwghyyvgqc0rp3vgu5ye4nd236ml57rjh083a2755qemf6dk6pw0qrnfm7246s8eg2hhzkzpf9h73chhng7xhmyem2sjh8rs2m9nhfcslsgenm"
           it "returns 401 with bad session" $ do
             req <-
               testPostJson "/api/ownervk" $
@@ -768,7 +743,7 @@ main = do
                 [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
                 req
             getResponseStatus res `shouldBe` badRequest400
-          it "succeeds with correct key" $ do
+          it "succeeds with correct Sapling key" $ do
             req <-
               testPostJson "/api/ownervk" $
               A.object ["payload" A..= (vk1 :: String)]
@@ -778,14 +753,34 @@ main = do
                 [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
                 req
             getResponseStatus res `shouldBe` created201
+          it "succeeds with correct Unified key and UA" $ do
+            req <-
+              testPostJson "/api/ownervk" $
+              A.object ["payload" A..= (vk3 :: String)]
+            res <-
+              httpLBS $
+              setRequestQueryString
+                [("session", Just "35bfb9c2-9ad2-4fe5-daad-99d63b8dcdaa")]
+                req
+            getResponseStatus res `shouldBe` created201
+          xit "succeeds with correct Unified key and Sapling address" $ do
+            req <-
+              testPostJson "/api/ownervk" $
+              A.object ["payload" A..= (vk3 :: String)]
+            res <-
+              httpLBS $
+              setRequestQueryString
+                [("session", Just "35bfb9c2-a92d-4fe5-daad-99d63b8dcdaa")]
+                req
+            getResponseStatus res `shouldBe` created201
     around handleDb $
       describe "Database actions" $ do
         describe "authentication" $ do
           it "should succeed with good creds" $ \p -> do
-            r <- liftIO $ access p master "zgo" (auth "zgo" "zcashrules")
+            r <- liftIO $ access p master "test" (auth "zgo" "zcashrules")
             r `shouldBe` True
           it "should fail with bad creds" $ \p -> do
-            r <- liftIO $ access p master "zgo" (auth "user" "pwd")
+            r <- liftIO $ access p master "test" (auth "user" "pwd")
             r `shouldBe` False
         describe "ZGo Pro sessions" $ do
           it "find in DB" $ \p -> do
@@ -799,21 +794,21 @@ main = do
           it "should update" $ \p -> do
             doc <- access p master "test" $ findPrice "usd"
             case doc of
-              Nothing -> True `shouldBe` False
+              Nothing -> assertFailure "couldn't find price"
               Just d -> do
                 let q = parseZGoPrice d
                 case q of
-                  Nothing -> True `shouldBe` False
+                  Nothing -> assertFailure "couldn't parse price"
                   Just r -> do
                     let t1 = ZGoBackend.timestamp r
                     _ <- checkZcashPrices p "test"
                     doc2 <- access p master "test" $ findPrice "usd"
                     case doc2 of
-                      Nothing -> True `shouldBe` False
+                      Nothing -> assertFailure "couldn't find price"
                       Just d2 -> do
                         let q2 = parseZGoPrice d2
                         case q2 of
-                          Nothing -> True `shouldBe` False
+                          Nothing -> assertFailure "couldn't parse price"
                           Just r2 -> do
                             let t2 = ZGoBackend.timestamp r2
                             t2 `shouldSatisfy` (t1 <)
@@ -866,6 +861,9 @@ main = do
                     ""
                     ""
                     "testToken1234"
+                    0
+                    0
+                    0
             let ordTest = val myOrder
             case ordTest of
               Doc oT -> access p master "test" (insert_ "orders" oT)
@@ -909,7 +907,7 @@ main = do
           xit "logins are added to db" $ \p -> do
             _ <-
               access p master "test" (Database.MongoDB.delete (select [] "txs"))
-            _ <- scanZcash loadedConfig p
+            _ <- scanZcash' loadedConfig p
             threadDelay 1000000
             t <- access p master "test" $ findOne (select [] "txs")
             let s = parseZGoTxBson =<< t
@@ -922,7 +920,7 @@ main = do
                 master
                 "test"
                 (Database.MongoDB.delete (select [] "payments"))
-            _ <- scanZcash loadedConfig p
+            _ <- scanZcash' loadedConfig p
             threadDelay 1000000
             t <- access p master "test" $ findOne (select [] "payments")
             let s = (cast' . Doc) =<< t
@@ -1136,7 +1134,7 @@ testItemAdd i = do
 openDbConnection :: IO Pipe
 openDbConnection = do
   pipe <- connect $ host "127.0.0.1"
-  access pipe master "zgo" (auth "zgo" "zcashrules")
+  access pipe master "test" (auth "zgo" "zcashrules")
   return pipe
 
 -- | Close the MongoDB pipe
@@ -1158,17 +1156,40 @@ unwrapDoc _ = []
 startAPI :: Config -> IO ()
 startAPI config = do
   putStrLn "Starting test server ..."
-  pipe <- connect $ host "127.0.0.1"
-  c <- access pipe master "zgo" (auth "zgo" "zcashrules")
+  pipe <- connect $ host $ c_dbHost config
+  c <- access pipe master "test" (auth (c_dbUser config) (c_dbPassword config))
   let appRoutes = routes pipe config
   _ <- forkIO (scotty 3000 appRoutes)
   _ <-
-    access pipe master "test" (Database.MongoDB.delete (select [] "wootokens"))
-  _ <- access pipe master "test" (Database.MongoDB.delete (select [] "users"))
-  _ <- access pipe master "test" (Database.MongoDB.delete (select [] "items"))
-  _ <- access pipe master "test" (Database.MongoDB.delete (select [] "orders"))
+    access
+      pipe
+      master
+      (c_dbName config)
+      (Database.MongoDB.delete (select [] "wootokens"))
   _ <-
-    access pipe master "test" (Database.MongoDB.delete (select [] "xerotokens"))
+    access
+      pipe
+      master
+      (c_dbName config)
+      (Database.MongoDB.delete (select [] "users"))
+  _ <-
+    access
+      pipe
+      master
+      (c_dbName config)
+      (Database.MongoDB.delete (select [] "items"))
+  _ <-
+    access
+      pipe
+      master
+      (c_dbName config)
+      (Database.MongoDB.delete (select [] "orders"))
+  _ <-
+    access
+      pipe
+      master
+      (c_dbName config)
+      (Database.MongoDB.delete (select [] "xerotokens"))
   let myUser =
         User
           (Just (read "6272a90f2b05a74cf1000001" :: ObjectId))
@@ -1193,8 +1214,25 @@ startAPI config = do
           1613487
           "8ea140fbb30615d6cae383c4f62f3ad9afb10b804f63138d5b53990bd56e0162"
           True
+  let myUser3 =
+        User
+          (Just (read "6272a90f2b05a74cf1500003" :: ObjectId))
+          "u15hjz9v46azzmdept050heh8795qxzwy2pykg097lg69jpk4qzah90cj2q4amq0c07gta60x8qgw00qewcy3hg9kv9h6zjkh3jc66vr40u6uu2dxmqkqhypud95vm0gq7y5ga7c8psdqgthsrwvgd676a2pavpcd4euwwapgackxa3qhvga0wnl0k6vncskxlq94vqwjd7zepy3qd5jh"
+          "35bfb9c2-9ad2-4fe5-daad-99d63b8dcdaa"
+          1613487
+          "8ea140fbb30615d6cae383c4f62f3ad9afb10b804f63138d5b53990bd56e0162"
+          True
+  let myUser4 =
+        User
+          (Just (read "6272a90f2b05a74cf7500003" :: ObjectId))
+          "zs1fau9x305eztcdm5f08q9uc4hmvvjpjrgjcwcj0mjwhd83pdj0j92rxwqp6zkjmz3e49ej4xrcc8"
+          "35bfb9c2-a92d-4fe5-daad-99d63b8dcdaa"
+          1613487
+          "8ea140fbb30615d6cae383c4f62f3ad9afb10b804f63138d5b53990bd56e0162"
+          True
   let userList =
-        map unwrapDoc $ filter filterDocs $ val <$> [myUser, myUser1, myUser2]
+        map unwrapDoc $
+        filter filterDocs $ val <$> [myUser, myUser1, myUser2, myUser3, myUser4]
   _ <- access pipe master "test" (insertAll_ "users" userList)
   let myOwner =
         Owner
@@ -1223,6 +1261,7 @@ startAPI config = do
           False
           ""
           ""
+          False
   let myOwner1 =
         Owner
           (Just (read "627ad3492b05a76be3000008"))
@@ -1250,6 +1289,63 @@ startAPI config = do
           False
           ""
           ""
+          False
+  let myOwner2 =
+        Owner
+          (Just (read "627ad3492b05a76be3700008"))
+          "u15hjz9v46azzmdept050heh8795qxzwy2pykg097lg69jpk4qzah90cj2q4amq0c07gta60x8qgw00qewcy3hg9kv9h6zjkh3jc66vr40u6uu2dxmqkqhypud95vm0gq7y5ga7c8psdqgthsrwvgd676a2pavpcd4euwwapgackxa3qhvga0wnl0k6vncskxlq94vqwjd7zepy3qd5jh"
+          "Test shop 3"
+          "usd"
+          False
+          0
+          False
+          0
+          "Roxy"
+          "Foo"
+          "roxy@zgo.cash"
+          "1 Main St"
+          "Mpls"
+          "Minnesota"
+          "55401"
+          ""
+          "missyfoo.io"
+          "United States"
+          True
+          False
+          False
+          (UTCTime (fromGregorian 2024 8 6) (secondsToDiffTime 0))
+          False
+          ""
+          ""
+          False
+  let myOwner3 =
+        Owner
+          (Just (read "627ad3492b05a76be3750008"))
+          "zs1fau9x305eztcdm5f08q9uc4hmvvjpjrgjcwcj0mjwhd83pdj0j92rxwqp6zkjmz3e49ej4xrcc8"
+          "Test shop 4"
+          "usd"
+          False
+          0
+          False
+          0
+          "Roxy"
+          "Foo"
+          "roxy@zgo.cash"
+          "1 Main St"
+          "Mpls"
+          "Minnesota"
+          "55401"
+          ""
+          "missyfoo.io"
+          "United States"
+          True
+          False
+          False
+          (UTCTime (fromGregorian 2024 8 6) (secondsToDiffTime 0))
+          False
+          ""
+          ""
+          False
   _ <- access pipe master "test" (Database.MongoDB.delete (select [] "owners"))
   let o = val myOwner
   case o of
@@ -1259,6 +1355,14 @@ startAPI config = do
   case o1 of
     Doc d1 -> access pipe master "test" (insert_ "owners" d1)
     _ -> fail "Couldn't save Owner1 in DB"
+  let o2 = val myOwner2
+  case o2 of
+    Doc d2 -> access pipe master "test" (insert_ "owners" d2)
+    _ -> fail "Couldn't save Owner2 in DB"
+  let o3 = val myOwner3
+  case o3 of
+    Doc d3 -> access pipe master "test" (insert_ "owners" d3)
+    _ -> fail "Couldn't save Owner2 in DB"
   _ <- access pipe master "test" (Database.MongoDB.delete (select [] "orders"))
   myTs <- liftIO getCurrentTime
   let myOrder =
@@ -1277,6 +1381,9 @@ startAPI config = do
           ""
           ""
           "testToken1234"
+          0
+          0
+          0
   let ordTest = val myOrder
   case ordTest of
     Doc oT -> access pipe master "test" (insert_ "orders" oT)
@@ -1342,7 +1449,10 @@ instance Arbitrary ZGoOrder where
     pd <- arbitrary
     eI <- arbitrary
     sc <- arbitrary
-    ZGoOrder i a s ts c cur p t tZ l pd eI sc <$> arbitrary
+    tk <- arbitrary
+    qT <- arbitrary
+    qV <- arbitrary
+    ZGoOrder i a s ts c cur p t tZ l pd eI sc tk qT qV <$> arbitrary
 
 instance Arbitrary LineItem where
   arbitrary = do
@@ -1381,7 +1491,33 @@ instance Arbitrary Owner where
     exp <- arbitrary
     payconf <- arbitrary
     vk <- arbitrary
-    Owner i a n c t tV v vV f l e s ct st p ph w co paid zats inv exp payconf vk <$>
+    cT <- arbitrary
+    Owner
+      i
+      a
+      n
+      c
+      t
+      tV
+      v
+      vV
+      f
+      l
+      e
+      s
+      ct
+      st
+      p
+      ph
+      w
+      co
+      paid
+      zats
+      inv
+      exp
+      payconf
+      vk
+      cT <$>
       arbitrary
 
 instance Arbitrary Item where

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.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.6.0
+version:        1.9.0
 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:
@@ -20,10 +20,6 @@ extra-source-files:
     CHANGELOG.md
     zgo.cfg
 
-source-repository head
-  type: git
-  location: https://git.vergara.tech/Vergara_Tech/zgo-backend
-
 library
   exposed-modules:
       Config
@@ -37,8 +33,6 @@ library
       Xero
       ZGoBackend
       ZGoTx
-  other-modules:
-      Paths_zgo_backend
   hs-source-dirs:
       src
   build-depends:
@@ -83,13 +77,11 @@ library
 
 executable zgo-backend-exe
   main-is: Server.hs
-  other-modules:
-      Tasks
-      TokenRefresh
-      Paths_zgo_backend
   hs-source-dirs:
       app
   ghc-options: -main-is Server -threaded -rtsopts -with-rtsopts=-N -Wall
+  pkgconfig-depends:
+      rustzcash_wrapper
   build-depends:
       aeson
     , base
@@ -98,7 +90,7 @@ executable zgo-backend-exe
     , http-conduit
     , http-types
     , megaparsec
-    , mongoDB
+    , mongoDB >=2.7.1.4
     , scotty
     , securemem
     , text
@@ -111,13 +103,11 @@ executable zgo-backend-exe
 
 executable zgo-tasks
   main-is: Tasks.hs
-  other-modules:
-      Server
-      TokenRefresh
-      Paths_zgo_backend
   hs-source-dirs:
       app
   ghc-options: -main-is Tasks -threaded -rtsopts -with-rtsopts=-N -Wall
+  pkgconfig-depends:
+      rustzcash_wrapper
   build-depends:
       base
     , megaparsec
@@ -131,13 +121,11 @@ executable zgo-tasks
 
 executable zgo-token-refresh
   main-is: TokenRefresh.hs
-  other-modules:
-      Server
-      Tasks
-      Paths_zgo_backend
   hs-source-dirs:
       app
   ghc-options: -main-is TokenRefresh -threaded -rtsopts -with-rtsopts=-N -Wall
+  pkgconfig-depends:
+      rustzcash_wrapper
   build-depends:
       aeson
     , base
@@ -160,11 +148,11 @@ executable zgo-token-refresh
 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
@@ -175,6 +163,7 @@ test-suite zgo-backend-test
     , hspec-expectations-json
     , hspec-wai
     , http-conduit
+    , HUnit
     , http-types
     , megaparsec
     , mongoDB