From e0f263f7f0a118e0df5579a164954918a05c5f08 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Thu, 20 Jul 2023 10:13:47 -0500
Subject: [PATCH 01/57] Test updates

---
 src/ZGoBackend.hs |  3 ++-
 test/Spec.hs      | 57 +++++++++++++++++++++++++++++++++++++++++++++--
 zgo-backend.cabal |  2 +-
 3 files changed, 58 insertions(+), 4 deletions(-)

diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index 99d5cde..c67fe69 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -364,10 +364,11 @@ zToZGoTx (ZcashTx t a aZ bh bt c conf m) = do
 
 zToZGoTx' :: Config -> Pipe -> ZcashTx -> IO ()
 zToZGoTx' config pipe (ZcashTx t a aZ bh bt c conf m) = do
-  when (conf < 100) $ do
+  when (conf < c_confirmations config) $ do
     let zM = runParser pZGoMemo (T.unpack t) m
     case zM of
       Right zM' -> do
+        print zM'
         let tx =
               ZGoTx
                 Nothing
diff --git a/test/Spec.hs b/test/Spec.hs
index 5f17d11..264d458 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -81,6 +81,17 @@ main = do
             Right m' ->
               m_session m' `shouldBe`
               U.fromString "ad8477d3-4fdd-4c97-90b2-76630b5f77e1"
+        it "parse Zingo memo" $ 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 "converts ZecWallet tx to ZGo tx" $ do
           let t =
                 ZcashTx
@@ -123,6 +134,27 @@ main = do
               0.5
               "someId"
               "\128737MSG\nzs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e\n\nZGO::ad8477d3-4fdd-4c97-90b2-76630b5f77e1"
+        it "converts Zingo 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 ZecWallet payment tx to ZGo tx" $ do
           let t =
                 ZcashTx
@@ -165,6 +197,27 @@ main = do
               0.5
               "someId"
               "\128737MSG\nzs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e\n\nZGOp::ad8477d3-4fdd-4c97-90b2-76630b5f77e1"
+        it "converts Zingo 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"
       describe "PIN generator" $ do
         it "should give a 7 digit" $ do
           pin <- generatePin
@@ -909,7 +962,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 +975,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
diff --git a/zgo-backend.cabal b/zgo-backend.cabal
index 264cfbf..e9b46b8 100644
--- a/zgo-backend.cabal
+++ b/zgo-backend.cabal
@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           zgo-backend
-version:        1.6.0
+version:        1.7.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

From e586321fafb372e55a9b7620e12b08d2307e7af3 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Thu, 27 Jul 2023 13:34:35 -0500
Subject: [PATCH 02/57] Update to new patched version of MongoDB driver

---
 CHANGELOG.md      |  6 ++++++
 package.yaml      |  2 +-
 stack.yaml        |  5 ++++-
 stack.yaml.lock   | 19 +++++++++++++++----
 zgo-backend.cabal |  2 +-
 5 files changed, 27 insertions(+), 7 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 28ec2bc..9f26074 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -4,6 +4,12 @@ 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]
+
+## Changed
+
+- MongoDB driver updated to support MongoDB 6.
+
 ## [1.7.0]
 
 ### Added
diff --git a/package.yaml b/package.yaml
index 6953890..4f4d860 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name:                zgo-backend
-version:             1.7.0
+version:             1.8.0
 git:                 "https://git.vergara.tech/Vergara_Tech/zgo-backend"
 license:             BOSL
 author:              "Rene Vergara"
diff --git a/stack.yaml b/stack.yaml
index d65ab03..c92b599 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -17,7 +17,7 @@
 #
 # resolver: ./custom-snapshot.yaml
 # resolver: https://example.com/snapshots/2018-01-01.yaml
-resolver: lts-20.23
+resolver: lts-21.4
   #url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/4.yaml
 
 # User packages to be built.
@@ -50,6 +50,9 @@ extra-deps:
     commit: 787c2e813eb3a5d16c375d4b37dfefbd2adcdf05
   - git: https://github.com/well-typed/borsh.git
     commit: d2fcfa159e0a844b1ec5e8ed3e232d4b380fa831
+  - git: https://git.vergara.tech/Vergara_Tech/mongodb.git
+    commit: 22537d87eea77721d1f56a9690c51ffcb64f7390
+      #  - network-2.8.0.1@sha256:a79f3cf88b2623d5f2e7a8fc7962055f6858d6beb6d13c2aef43c20a5060cf28,3034
   - aeson-2.1.2.1@sha256:5b8d62a60963a925c4d123a46e42a8e235a32188522c9f119f64ac228c2612a7,6359
   - vector-0.13.0.0@sha256:fa5cac81a17a5af388716792e8b99c24b3b66770086756d0d8b23f8272a0244c,9112
   - generically-0.1.1
diff --git a/stack.yaml.lock b/stack.yaml.lock
index 552f32f..fdc93d3 100644
--- a/stack.yaml.lock
+++ b/stack.yaml.lock
@@ -48,6 +48,17 @@ packages:
   original:
     commit: d2fcfa159e0a844b1ec5e8ed3e232d4b380fa831
     git: https://github.com/well-typed/borsh.git
+- completed:
+    commit: 22537d87eea77721d1f56a9690c51ffcb64f7390
+    git: https://git.vergara.tech/Vergara_Tech/mongodb.git
+    name: mongoDB
+    pantry-tree:
+      sha256: f0a5cd9b243a746be6b277719413c766ee0983a9012ff7ad7d4fc6140a68d2a9
+      size: 2297
+    version: 2.7.1.2
+  original:
+    commit: 22537d87eea77721d1f56a9690c51ffcb64f7390
+    git: https://git.vergara.tech/Vergara_Tech/mongodb.git
 - completed:
     hackage: aeson-2.1.2.1@sha256:5b8d62a60963a925c4d123a46e42a8e235a32188522c9f119f64ac228c2612a7,6359
     pantry-tree:
@@ -92,7 +103,7 @@ packages:
     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
+    sha256: caa77fdbc5b9f698262b21ee78030133272ec53116ad6ddbefdc4c321f668e0c
+    size: 640014
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/21/4.yaml
+  original: lts-21.4
diff --git a/zgo-backend.cabal b/zgo-backend.cabal
index e9b46b8..9710f2c 100644
--- a/zgo-backend.cabal
+++ b/zgo-backend.cabal
@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           zgo-backend
-version:        1.7.0
+version:        1.8.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

From bacb2369e0dba2109a35514d29ad4087e5a4c7f4 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Mon, 7 Aug 2023 13:34:07 -0500
Subject: [PATCH 03/57] Update MongoDB driver

---
 stack.yaml      | 2 +-
 stack.yaml.lock | 6 +++---
 2 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/stack.yaml b/stack.yaml
index c92b599..a95f0ac 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -51,7 +51,7 @@ extra-deps:
   - git: https://github.com/well-typed/borsh.git
     commit: d2fcfa159e0a844b1ec5e8ed3e232d4b380fa831
   - git: https://git.vergara.tech/Vergara_Tech/mongodb.git
-    commit: 22537d87eea77721d1f56a9690c51ffcb64f7390
+    commit: 63bba3a6d30e5fd73c71fd7da752b2647d94f58e
       #  - network-2.8.0.1@sha256:a79f3cf88b2623d5f2e7a8fc7962055f6858d6beb6d13c2aef43c20a5060cf28,3034
   - aeson-2.1.2.1@sha256:5b8d62a60963a925c4d123a46e42a8e235a32188522c9f119f64ac228c2612a7,6359
   - vector-0.13.0.0@sha256:fa5cac81a17a5af388716792e8b99c24b3b66770086756d0d8b23f8272a0244c,9112
diff --git a/stack.yaml.lock b/stack.yaml.lock
index fdc93d3..cb196ff 100644
--- a/stack.yaml.lock
+++ b/stack.yaml.lock
@@ -49,15 +49,15 @@ packages:
     commit: d2fcfa159e0a844b1ec5e8ed3e232d4b380fa831
     git: https://github.com/well-typed/borsh.git
 - completed:
-    commit: 22537d87eea77721d1f56a9690c51ffcb64f7390
+    commit: 63bba3a6d30e5fd73c71fd7da752b2647d94f58e
     git: https://git.vergara.tech/Vergara_Tech/mongodb.git
     name: mongoDB
     pantry-tree:
-      sha256: f0a5cd9b243a746be6b277719413c766ee0983a9012ff7ad7d4fc6140a68d2a9
+      sha256: 63af9dc2612131fb5d1ea9d75b7055d5d0b28ca443149be1fb47c22bf204128f
       size: 2297
     version: 2.7.1.2
   original:
-    commit: 22537d87eea77721d1f56a9690c51ffcb64f7390
+    commit: 63bba3a6d30e5fd73c71fd7da752b2647d94f58e
     git: https://git.vergara.tech/Vergara_Tech/mongodb.git
 - completed:
     hackage: aeson-2.1.2.1@sha256:5b8d62a60963a925c4d123a46e42a8e235a32188522c9f119f64ac228c2612a7,6359

From eda0f9336c64ef34334ef56c2a2e07b992b50e73 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Sat, 12 Aug 2023 20:41:27 -0500
Subject: [PATCH 04/57] Fix issue 56

---
 src/ZGoBackend.hs | 155 +++++++++++++++++++++-------------------------
 1 file changed, 69 insertions(+), 86 deletions(-)

diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index c67fe69..85d1ac8 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -72,39 +72,33 @@ import ZcashHaskell.Utils (decodeBech32)
 
 -- Models for API objects
 -- | A type to model Zcash RPC calls
-data RpcCall =
-  RpcCall
-    { jsonrpc :: T.Text
-    , callId :: T.Text
-    , method :: T.Text
-    , parameters :: [Data.Aeson.Value]
-    }
-  deriving (Show, Generic)
+data RpcCall = RpcCall
+  { jsonrpc :: T.Text
+  , callId :: T.Text
+  , method :: T.Text
+  , parameters :: [Data.Aeson.Value]
+  } deriving (Show, Generic)
 
 instance ToJSON RpcCall where
   toJSON (RpcCall j c m p) =
     object ["jsonrpc" .= j, "id" .= c, "method" .= m, "params" .= p]
 
 -- | A type to model the response of the Zcash RPC
-data RpcResponse r =
-  MakeRpcResponse
-    { err :: Maybe RpcError
-    , respId :: T.Text
-    , result :: Maybe r
-    }
-  deriving (Show, Generic, ToJSON)
+data RpcResponse r = MakeRpcResponse
+  { err :: Maybe RpcError
+  , respId :: T.Text
+  , result :: Maybe r
+  } deriving (Show, Generic, ToJSON)
 
 instance (FromJSON r) => FromJSON (RpcResponse r) where
   parseJSON (Object obj) =
     MakeRpcResponse <$> obj .: "error" <*> obj .: "id" <*> obj .: "result"
   parseJSON _ = mzero
 
-data RpcError =
-  RpcError
-    { ecode :: Double
-    , emessage :: T.Text
-    }
-  deriving (Show, Generic, ToJSON)
+data RpcError = RpcError
+  { ecode :: Double
+  , emessage :: T.Text
+  } deriving (Show, Generic, ToJSON)
 
 instance FromJSON RpcError where
   parseJSON =
@@ -113,41 +107,35 @@ instance FromJSON RpcError where
       m <- obj .: "message"
       pure $ RpcError c m
 
-data Payload r =
-  Payload
-    { payload :: r
-    }
-  deriving (Show, Generic, ToJSON)
+data Payload r = Payload
+  { payload :: r
+  } deriving (Show, Generic, ToJSON)
 
 instance (FromJSON r) => FromJSON (Payload r) where
   parseJSON (Object obj) = Payload <$> obj .: "payload"
   parseJSON _ = mzero
 
 -- | Type to model a (simplified) block of Zcash blockchain
-data Block =
-  Block
-    { height :: Integer
-    , size :: Integer
-    }
-  deriving (Show, Generic, ToJSON)
+data Block = Block
+  { height :: Integer
+  , size :: Integer
+  } deriving (Show, Generic, ToJSON)
 
 instance FromJSON Block where
   parseJSON (Object obj) = Block <$> obj .: "height" <*> obj .: "size"
   parseJSON _ = mzero
 
 -- | Type to model a Zcash shielded transaction
-data ZcashTx =
-  ZcashTx
-    { ztxid :: T.Text
-    , zamount :: Double
-    , zamountZat :: Integer
-    , zblockheight :: Integer
-    , zblocktime :: Integer
-    , zchange :: Bool
-    , zconfirmations :: Integer
-    , zmemo :: T.Text
-    }
-  deriving (Show, Generic)
+data ZcashTx = ZcashTx
+  { ztxid :: T.Text
+  , zamount :: Double
+  , zamountZat :: Integer
+  , zblockheight :: Integer
+  , zblocktime :: Integer
+  , zchange :: Bool
+  , zconfirmations :: Integer
+  , zmemo :: T.Text
+  } deriving (Show, Generic)
 
 instance FromJSON ZcashTx where
   parseJSON =
@@ -196,14 +184,12 @@ instance Arbitrary ZcashTx where
     ZcashTx a aZ t bh bt c cm <$> arbitrary
 
 -- | A type to model an address group
-data AddressGroup =
-  AddressGroup
-    { agsource :: AddressSource
-    , agtransparent :: [ZcashAddress]
-    , agsapling :: [ZcashAddress]
-    , agunified :: [ZcashAddress]
-    }
-  deriving (Show, Generic)
+data AddressGroup = AddressGroup
+  { agsource :: AddressSource
+  , agtransparent :: [ZcashAddress]
+  , agsapling :: [ZcashAddress]
+  , agunified :: [ZcashAddress]
+  } deriving (Show, Generic)
 
 instance FromJSON AddressGroup where
   parseJSON =
@@ -284,14 +270,12 @@ instance FromJSON ZcashPool where
       "orchard" -> return Orchard
       _ -> fail "Not a known Zcash pool"
 
-data ZcashAddress =
-  ZcashAddress
-    { source :: AddressSource
-    , pool :: [ZcashPool]
-    , account :: Maybe Integer
-    , addy :: T.Text
-    }
-  deriving (Eq)
+data ZcashAddress = ZcashAddress
+  { source :: AddressSource
+  , pool :: [ZcashPool]
+  , account :: Maybe Integer
+  , addy :: T.Text
+  } deriving (Eq)
 
 instance Show ZcashAddress where
   show (ZcashAddress s p i a) =
@@ -315,13 +299,11 @@ encodeHexText t = T.unpack . toText . fromBytes $ E.encodeUtf8 t
 
 -- Types for the ZGo database documents
 -- | Type to model a country for the database's country list
-data Country =
-  Country
-    { _id :: String
-    , name :: T.Text
-    , code :: T.Text
-    }
-  deriving (Eq, Show, Generic, ToJSON)
+data Country = Country
+  { _id :: String
+  , name :: T.Text
+  , code :: T.Text
+  } deriving (Eq, Show, Generic, ToJSON)
 
 parseCountryBson :: B.Document -> Maybe Country
 parseCountryBson d = do
@@ -385,14 +367,12 @@ zToZGoTx' config pipe (ZcashTx t a aZ bh bt c conf m) = do
       Left e -> print $ "Failed to parse ZGo memo: " ++ show e
 
 -- |Type to model a price in the ZGo database
-data ZGoPrice =
-  ZGoPrice
-    { _id :: String
-    , currency :: T.Text
-    , price :: Double
-    , timestamp :: UTCTime
-    }
-  deriving (Eq, Show, Generic, ToJSON)
+data ZGoPrice = ZGoPrice
+  { _id :: String
+  , currency :: T.Text
+  , price :: Double
+  , timestamp :: UTCTime
+  } deriving (Eq, Show, Generic, ToJSON)
 
 parseZGoPrice :: B.Document -> Maybe ZGoPrice
 parseZGoPrice d = do
@@ -718,9 +698,11 @@ routes pipe config = do
                                                           [ "reportType" .=
                                                             (7 :: Integer)
                                                           , "order" .=
-                                                            (Nothing :: Maybe ZGoOrder)
+                                                            (Nothing :: Maybe
+                                                               ZGoOrder)
                                                           , "shop" .=
-                                                            (Nothing :: Maybe String)
+                                                            (Nothing :: Maybe
+                                                               String)
                                                           ])
                                                    Just cp -> do
                                                      let newOrder =
@@ -790,7 +772,8 @@ routes pipe config = do
                                                       [ "reportType" .=
                                                         (8 :: Integer)
                                                       , "order" .=
-                                                        (Nothing :: Maybe ZGoOrder)
+                                                        (Nothing :: Maybe
+                                                           ZGoOrder)
                                                       , "shop" .=
                                                         (Nothing :: Maybe String)
                                                       ])
@@ -960,7 +943,8 @@ routes pipe config = do
         where blk3Hash :: String -> String
               blk3Hash s =
                 show
-                  (BLK.hash [BA.pack . BS.unpack . C.pack $ s :: BA.Bytes] :: BLK.Digest BLK.DEFAULT_DIGEST_LEN)
+                  (BLK.hash [BA.pack . BS.unpack . C.pack $ s :: BA.Bytes] :: BLK.Digest
+                     BLK.DEFAULT_DIGEST_LEN)
   get "/woopayment" $ do
     oid <- param "ownerid"
     t <- param "token"
@@ -1303,15 +1287,12 @@ routes pipe config = do
   get "/price" $ do
     curr <- param "currency"
     pr <- liftAndCatchIO $ run (findPrice curr)
-    case pr of
+    case parseZGoPrice =<< pr of
       Nothing -> do
         status noContent204
       Just p -> do
         Web.Scotty.json
-          (object
-             [ "message" .= ("Price found!" :: String)
-             , "price" .= toJSON (parseZGoPrice p)
-             ])
+          (object ["message" .= ("Price found!" :: String), "price" .= toJSON p])
     --Get all closed orders for the address
   get "/api/allorders" $ do
     session <- param "session"
@@ -1546,7 +1527,8 @@ listTxs user pwd a confs = do
       user
       pwd
       "z_listreceivedbyaddress"
-      [Data.Aeson.String a, Data.Aeson.Number $ Scientific.scientific confs 0] :: IO (Either HttpException (Response (RpcResponse [ZcashTx])))
+      [Data.Aeson.String a, Data.Aeson.Number $ Scientific.scientific confs 0] :: IO
+      (Either HttpException (Response (RpcResponse [ZcashTx])))
   case res of
     Right txList -> do
       let content = getResponseBody txList :: RpcResponse [ZcashTx]
@@ -1679,7 +1661,8 @@ scanPayments config pipe = do
 listAddresses :: BS.ByteString -> BS.ByteString -> IO [ZcashAddress]
 listAddresses user pwd = do
   response <-
-    try $ makeZcashCall user pwd "listaddresses" [] :: IO (Either HttpException (Response (RpcResponse [AddressGroup])))
+    try $ makeZcashCall user pwd "listaddresses" [] :: IO
+      (Either HttpException (Response (RpcResponse [AddressGroup])))
   case response of
     Right addrList -> do
       let rpcResp = getResponseBody addrList

From 7258af44c38f597c58b1278556b0c24d14cc4d9a Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Sat, 12 Aug 2023 21:17:42 -0500
Subject: [PATCH 05/57] Enable the config file in test suite

---
 test/Spec.hs | 37 ++++++++++++++++++++++++++++++-------
 1 file changed, 30 insertions(+), 7 deletions(-)

diff --git a/test/Spec.hs b/test/Spec.hs
index 264d458..e493d88 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -1211,17 +1211,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 "zgo" (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))

From 5ce72e5d951beaf8997fcff20e8e3646fda5e41f Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Mon, 14 Aug 2023 08:59:45 -0500
Subject: [PATCH 06/57] Update test suite

---
 test/Spec.hs | 128 +--------------------------------------------------
 1 file changed, 1 insertion(+), 127 deletions(-)

diff --git a/test/Spec.hs b/test/Spec.hs
index e493d88..5cd7576 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -56,7 +56,7 @@ 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
@@ -92,132 +92,6 @@ main = do
             Right m' ->
               m_session m' `shouldBe`
               U.fromString "5d3d4494-51c0-432d-8495-050419957aea"
-        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 Zingo 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 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 "converts Zingo 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"
       describe "PIN generator" $ do
         it "should give a 7 digit" $ do
           pin <- generatePin

From 528fdebe61b5a2f7263d3156c2aaa96dbf2bed55 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Wed, 27 Sep 2023 13:12:02 -0500
Subject: [PATCH 07/57] Add parser for Unified addresses

---
 src/ZGoTx.hs | 44 +++++++++++++++++++++++++-------------------
 1 file changed, 25 insertions(+), 19 deletions(-)

diff --git a/src/ZGoTx.hs b/src/ZGoTx.hs
index 8f786b8..30e7ef7 100644
--- a/src/ZGoTx.hs
+++ b/src/ZGoTx.hs
@@ -9,26 +9,26 @@ 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
 
 -- | 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,13 +100,11 @@ 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
+  } deriving (Eq, Show)
 
 data MemoToken
   = Login !U.UUID
@@ -139,6 +137,14 @@ pSaplingAddress = do
     then fail "Failed to parse Sapling address"
     else pure $ Address $ T.pack ("zs" <> a)
 
+pUnifiedAddress :: Parser MemoToken
+pUnifiedAddress = do
+  string "u1"
+  a <- some alphaNumChar
+  if isValidUnifiedAddress (E.encodeUtf8 $ "u1" <> T.pack a)
+    then pure $ Address $ T.pack ("u1" <> a)
+    else fail "Failed to parse Unified Address"
+
 pMsg :: Parser MemoToken
 pMsg = do
   msg <-

From fb436f1499a42beda525367c8cb578ae6c96f127 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Wed, 27 Sep 2023 13:18:16 -0500
Subject: [PATCH 08/57] Add full validation of Sapling address to parser

---
 src/ZGoTx.hs | 7 ++++---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/src/ZGoTx.hs b/src/ZGoTx.hs
index 30e7ef7..bf7b3d8 100644
--- a/src/ZGoTx.hs
+++ b/src/ZGoTx.hs
@@ -17,6 +17,7 @@ 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
@@ -133,9 +134,9 @@ 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

From 4c13ddcc483fa5e95276c81250559e4f1f896129 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Wed, 27 Sep 2023 13:42:51 -0500
Subject: [PATCH 09/57] Update code formatting

---
 src/Owner.hs | 139 +++++++++++++++++++++++++--------------------------
 1 file changed, 68 insertions(+), 71 deletions(-)

diff --git a/src/Owner.hs b/src/Owner.hs
index e1dbfa2..7985fc7 100644
--- a/src/Owner.hs
+++ b/src/Owner.hs
@@ -14,35 +14,33 @@ 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
+  } 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) =
@@ -276,21 +274,19 @@ instance Val Owner where
           ]
 
 -- | 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 +304,23 @@ 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
+  } deriving (Eq, Show, Generic)
 
 instance FromJSON OwnerSettings where
   parseJSON =
@@ -424,6 +418,11 @@ findExpiringOwners now =
        ["paid" =: True, "expiration" =: ["$lte" =: addUTCTime 172800 now]]
        "owners")
 
+findWithKeys :: Action IO [Document]
+findWithKeys =
+  rest =<<
+  find (select ["paid" =: True, "invoices" =: True, "payconf" =: True] "owners")
+
 removePro :: T.Text -> Action IO ()
 removePro o =
   modify (select ["address" =: o] "owners") ["$set" =: ["invoices" =: False]]
@@ -450,14 +449,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

From 51ae13e53b363c36297cb425d30d49b6238b6c54 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Thu, 28 Sep 2023 10:21:29 -0500
Subject: [PATCH 10/57] Update to latest version of `zcash-haskell`

---
 stack.yaml      |  2 +-
 stack.yaml.lock | 10 +++++-----
 2 files changed, 6 insertions(+), 6 deletions(-)

diff --git a/stack.yaml b/stack.yaml
index a95f0ac..5777d09 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -45,7 +45,7 @@ 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
+    commit: d78c269d96fe7d8a626cf701b8051c40f251e232
   - git: https://git.vergara.tech/Vergara_Tech/haskell-foreign-rust.git
     commit: 787c2e813eb3a5d16c375d4b37dfefbd2adcdf05
   - git: https://github.com/well-typed/borsh.git
diff --git a/stack.yaml.lock b/stack.yaml.lock
index cb196ff..0a0dddd 100644
--- a/stack.yaml.lock
+++ b/stack.yaml.lock
@@ -16,15 +16,15 @@ packages:
     commit: 085c16fb21b9f856a435a3faab980e7e0b319341
     git: https://github.com/reach-sh/haskell-hexstring.git
 - completed:
-    commit: fef3d3af35a09db718cddb8fc9166b2d2691a744
+    commit: d78c269d96fe7d8a626cf701b8051c40f251e232
     git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
     name: zcash-haskell
     pantry-tree:
-      sha256: ec7782cf2646da17548d59af0ea98dcbaac1b6c2176258c696a7f508db6dbc21
-      size: 1126
-    version: 0.1.0
+      sha256: 69201a27ac966be478ef0b8e3fa8e8bf5cbcc67a58cd254326545eb4f3e93569
+      size: 1229
+    version: 0.2.0
   original:
-    commit: fef3d3af35a09db718cddb8fc9166b2d2691a744
+    commit: d78c269d96fe7d8a626cf701b8051c40f251e232
     git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
 - completed:
     commit: 787c2e813eb3a5d16c375d4b37dfefbd2adcdf05

From c5724d6d4a1b9c3489915501a2ab84c91e773378 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Thu, 28 Sep 2023 10:46:41 -0500
Subject: [PATCH 11/57] Add tests for parsing UAs

---
 test/Spec.hs | 41 +++++++++++++++++++++++++++++++++++++----
 1 file changed, 37 insertions(+), 4 deletions(-)

diff --git a/test/Spec.hs b/test/Spec.hs
index 5cd7576..aadaec1 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -59,7 +59,7 @@ main = do
       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 +70,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,7 +81,7 @@ main = do
             Right m' ->
               m_session m' `shouldBe`
               U.fromString "ad8477d3-4fdd-4c97-90b2-76630b5f77e1"
-        it "parse Zingo memo" $ do
+        it "parse Zingo memo - Sapling" $ do
           let m =
                 runParser
                   pZGoMemo
@@ -92,6 +92,39 @@ main = do
             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_session m' `shouldBe`
+              U.fromString "5d3d4494-51c0-432d-8495-050419957aea"
+        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_session m' `shouldBe`
+              U.fromString "ad8477d3-4fdd-4c97-90b2-76630b5f77e1"
+        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_session m' `shouldBe`
+              U.fromString "5d3d4494-51c0-432d-8495-050419957aea"
       describe "PIN generator" $ do
         it "should give a 7 digit" $ do
           pin <- generatePin
@@ -262,7 +295,7 @@ main = do
           it "return owner by id" $ do
             req <-
               testGet
-                "/api/ownerid"
+                "/ownerid"
                 [ ("id", Just "627ad3492b05a76be3000001")
                 , ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")
                 ]

From a134947df6af5b0729be20540addffdc91fd36c6 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Thu, 28 Sep 2023 10:47:05 -0500
Subject: [PATCH 12/57] Alpha version of native Tx scanning

---
 CHANGELOG.md      |  15 +++-
 src/ZGoBackend.hs | 210 ++++++++++++++++++++++++++++++++--------------
 2 files changed, 162 insertions(+), 63 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 9f26074..2712b8b 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -6,9 +6,22 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 
 ## [Unreleased]
 
-## Changed
+### 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
 
 - MongoDB driver updated to support MongoDB 6.
+- Full validation of Sapling addresses to parser.
+
+### Removed
+
+- `makeZcashCall` function moved to the generic `zcash-haskell` library.
+- `RpcResponse`, `RpcCall` types moved to the generic `zcash-haskell` library.
 
 ## [1.7.0]
 
diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index 85d1ac8..83539ed 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -25,7 +25,7 @@ import Data.Char
 import qualified Data.HashMap.Strict as HM
 import Data.HexString
 import Data.Maybe
-import qualified Data.Scientific as Scientific
+import qualified Data.Scientific as SC
 import Data.SecureMem
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as E
@@ -37,9 +37,8 @@ import Data.Time.Format
 import Data.Typeable
 import qualified Data.UUID as U
 import qualified Data.Vector as V
-import Data.Vector.Internal.Check (doChecks)
 import Data.Word
-import Database.MongoDB hiding (Order)
+import Database.MongoDB hiding (Order, lookup)
 import Debug.Trace
 import GHC.Generics
 import Item
@@ -66,47 +65,20 @@ import Web.Scotty
 import WooCommerce
 import Xero
 import ZGoTx
+import ZcashHaskell.Orchard
 import ZcashHaskell.Sapling
-import ZcashHaskell.Types (RawData(..))
-import ZcashHaskell.Utils (decodeBech32)
+import ZcashHaskell.Types
+  ( BlockResponse(..)
+  , RawData(..)
+  , RawTxResponse(..)
+  , RpcCall(..)
+  , RpcError(..)
+  , RpcResponse(..)
+  , UnifiedFullViewingKey(..)
+  )
+import ZcashHaskell.Utils (decodeBech32, makeZcashCall)
 
 -- Models for API objects
--- | A type to model Zcash RPC calls
-data RpcCall = RpcCall
-  { jsonrpc :: T.Text
-  , callId :: T.Text
-  , method :: T.Text
-  , parameters :: [Data.Aeson.Value]
-  } deriving (Show, Generic)
-
-instance ToJSON RpcCall where
-  toJSON (RpcCall j c m p) =
-    object ["jsonrpc" .= j, "id" .= c, "method" .= m, "params" .= p]
-
--- | A type to model the response of the Zcash RPC
-data RpcResponse r = MakeRpcResponse
-  { err :: Maybe RpcError
-  , respId :: T.Text
-  , result :: Maybe r
-  } deriving (Show, Generic, ToJSON)
-
-instance (FromJSON r) => FromJSON (RpcResponse r) where
-  parseJSON (Object obj) =
-    MakeRpcResponse <$> obj .: "error" <*> obj .: "id" <*> obj .: "result"
-  parseJSON _ = mzero
-
-data RpcError = RpcError
-  { ecode :: Double
-  , emessage :: T.Text
-  } deriving (Show, Generic, ToJSON)
-
-instance FromJSON RpcError where
-  parseJSON =
-    withObject "RpcError" $ \obj -> do
-      c <- obj .: "code"
-      m <- obj .: "message"
-      pure $ RpcError c m
-
 data Payload r = Payload
   { payload :: r
   } deriving (Show, Generic, ToJSON)
@@ -1221,7 +1193,7 @@ routes pipe config = do
                                  "z_importviewingkey"
                                  [ Data.Aeson.String (T.strip . T.pack $ q)
                                  , "no"
-                                 ]
+                                 ] -- TODO: Remove this call to the node
                              let content =
                                    getResponseBody vkInfo :: RpcResponse Object
                              if isNothing (err content)
@@ -1233,7 +1205,7 @@ routes pipe config = do
                                  text $ L.pack . show $ err content
                                  status badRequest400
                      else status forbidden403
-              else status badRequest400
+              else status badRequest400 -- TODO: add Unified VK support
     --Get items associated with the given address
   get "/api/items" $ do
     session <- param "session"
@@ -1467,25 +1439,24 @@ routes pipe config = do
       {-liftAndCatchIO $-}
       {-mapM (run . loadLangComponent) (langComp :: [LangComponent])-}
     {-status created201-}
+     {-(MonadIO m, FromJSON a)-}
+  {-=> BS.ByteString-}
+  {--> BS.ByteString-}
+  {--> T.Text-}
+  {--> [Data.Aeson.Value]-}
+  {--> m (Response a)-}
+  {-let payload =-}
+        {-RpcCall {jsonrpc = "1.0", callId = "test", method = m, parameters = p}-}
+  {-let myRequest =-}
+        {-setRequestBodyJSON payload $-}
+        {-setRequestPort 8232 $-}
+        {-setRequestBasicAuth username password $-}
+        {-setRequestMethod "POST" defaultRequest-}
+  {-httpJSON myRequest-}
 
 -- | Make a Zcash RPC call
-makeZcashCall ::
-     (MonadIO m, FromJSON a)
-  => BS.ByteString
-  -> BS.ByteString
-  -> T.Text
-  -> [Data.Aeson.Value]
-  -> m (Response a)
-makeZcashCall username password m p = do
-  let payload =
-        RpcCall {jsonrpc = "1.0", callId = "test", method = m, parameters = p}
-  let myRequest =
-        setRequestBodyJSON payload $
-        setRequestPort 8232 $
-        setRequestBasicAuth username password $
-        setRequestMethod "POST" defaultRequest
-  httpJSON myRequest
-
+{-makeZcashCall ::-}
+{-makeZcashCall username password m p = do-}
 -- |Timer for repeating actions
 setInterval :: Int -> IO () -> IO ()
 setInterval secs func = do
@@ -1527,7 +1498,7 @@ listTxs user pwd a confs = do
       user
       pwd
       "z_listreceivedbyaddress"
-      [Data.Aeson.String a, Data.Aeson.Number $ Scientific.scientific confs 0] :: IO
+      [Data.Aeson.String a, Data.Aeson.Number $ SC.scientific confs 0] :: IO
       (Either HttpException (Response (RpcResponse [ZcashTx])))
   case res of
     Right txList -> do
@@ -1725,7 +1696,7 @@ payOwner p d x =
             markOwnerPaid :: Pipe -> T.Text -> Payment -> IO ()
             markOwnerPaid pipe db pmt = do
               user <- access pipe master db (findUser $ psession pmt)
-              print pmt
+              -- print pmt
               let parsedUser = parseUserBson =<< user
               let zaddy = maybe "" uaddress parsedUser
               owner <- access pipe master db $ findOwner zaddy
@@ -1831,4 +1802,119 @@ generateToken = do
   rngState <- newCryptoRNGState
   runCryptoRNGT rngState $ randomString 24 "abcdef0123456789"
 
+getBlockInfo ::
+     BS.ByteString -> BS.ByteString -> SC.Scientific -> IO (Maybe BlockResponse)
+getBlockInfo nodeUser nodePwd bh = do
+  blockInfo <- makeZcashCall nodeUser nodePwd "getblock" [Number bh]
+  let content = getResponseBody blockInfo :: RpcResponse BlockResponse
+  if isNothing (err content)
+    then return $ result content
+    else do
+      print $ err content
+      return Nothing
+
+scanTxNative :: Pipe -> T.Text -> BS.ByteString -> BS.ByteString -> IO ()
+scanTxNative pipe db nodeUser nodePwd = do
+  keyOwnerList <- access pipe master db findWithKeys
+  unless (null keyOwnerList) $ do
+    let ownerList = cast' . Doc <$> keyOwnerList
+    let keyList = map (maybe "" oviewkey) ownerList
+    lastBlockData <- access pipe master db findBlock
+    latestBlock <- getBlockInfo nodeUser nodePwd (SC.scientific (-1) 0)
+    case latestBlock of
+      Nothing -> fail "No block data from node"
+      Just lB -> do
+        case cast' . Doc =<< lastBlockData of
+          Nothing -> do
+            blockList <-
+              mapM
+                (getBlockInfo nodeUser nodePwd . fromInteger)
+                [2220000 .. (bl_height lB)]
+            let filteredBlockList = filter filterBlock blockList
+            let txIdList = concatMap extractTxs filteredBlockList
+            txList <- mapM (getTxData nodeUser nodePwd) txIdList
+            let filteredTxList = map fromJust $ filter filterTx txList
+            mapM_ (checkTx filteredTxList) keyList
+          Just lastBlock -> do
+            let blockList' = [(bl_height lastBlock + 1) .. (bl_height lB)]
+            print blockList'
+    print keyList
+  where
+    filterBlock :: Maybe BlockResponse -> Bool
+    filterBlock b = maybe 0 bl_confirmations b >= 5
+    filterTx :: Maybe RawTxResponse -> Bool
+    filterTx t =
+      not (null (maybe [] rt_shieldedOutputs t)) &&
+      not (null (maybe [] rt_orchardActions t))
+    extractTxs :: Maybe BlockResponse -> [T.Text]
+    extractTxs = maybe [] bl_txs
+    getTxData ::
+         BS.ByteString -> BS.ByteString -> T.Text -> IO (Maybe RawTxResponse)
+    getTxData nodeUser nodePwd txid = do
+      txInfo <-
+        makeZcashCall
+          nodeUser
+          nodePwd
+          "getrawtransaction"
+          [Data.Aeson.String txid]
+      let content = getResponseBody txInfo :: RpcResponse RawTxResponse
+      if isNothing (err content)
+        then return $ result content
+        else do
+          print $ err content
+          return Nothing
+    checkTx :: [RawTxResponse] -> T.Text -> IO ()
+    checkTx txList k = do
+      if isValidSaplingViewingKey (E.encodeUtf8 k)
+        then do
+          let decodedTxList =
+                map
+                  (decodeSaplingOutput (E.encodeUtf8 k))
+                  (concatMap
+                     rt_shieldedOutputs
+                     (filter (\x -> rt_shieldedOutputs x /= []) txList))
+          print decodedTxList
+        else do
+          let vk = decodeUfvk $ E.encodeUtf8 k
+          case vk of
+            Nothing -> print "Not a valid key"
+            Just v -> do
+              let decodedSapList =
+                    map
+                      (decodeSaplingOutput (s_key v))
+                      (concatMap rt_shieldedOutputs txList)
+              print decodedSapList
+              let decodedOrchList =
+                    map
+                      (decryptOrchardAction v)
+                      (concatMap rt_orchardActions txList)
+              print decodedOrchList
+
 debug = flip trace
+
+instance Val BlockResponse where
+  cast' (Doc d) = do
+    c <- B.lookup "confirmations" d
+    h <- B.lookup "height" d
+    t <- B.lookup "time" d
+    txs <- B.lookup "tx" d
+    Just (BlockResponse c h t txs)
+  cast' _ = Nothing
+  val (BlockResponse c h t txs) =
+    Doc
+      [ "confirmations" =: c
+      , "height" =: h
+      , "time" =: t
+      , "tx" =: txs
+      , "network" =: ("mainnet" :: String)
+      ]
+
+upsertBlock :: BlockResponse -> Action IO ()
+upsertBlock b = do
+  let block = val b
+  case block of
+    Doc d -> upsert (select ["network" =: ("mainnet" :: String)] "blocks") d
+    _ -> return ()
+
+findBlock :: Action IO (Maybe Document)
+findBlock = findOne (select ["network" =: ("mainnet" :: String)] "blocks")

From 85bf0fef59b1b3469cf3f30859fd7b678b5f67e3 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Thu, 28 Sep 2023 13:11:48 -0500
Subject: [PATCH 13/57] Fix call to `getblock`

---
 src/ZGoBackend.hs | 7 ++++++-
 1 file changed, 6 insertions(+), 1 deletion(-)

diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index 83539ed..7cfe0c0 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -1805,7 +1805,12 @@ generateToken = do
 getBlockInfo ::
      BS.ByteString -> BS.ByteString -> SC.Scientific -> IO (Maybe BlockResponse)
 getBlockInfo nodeUser nodePwd bh = do
-  blockInfo <- makeZcashCall nodeUser nodePwd "getblock" [Number bh]
+  blockInfo <-
+    makeZcashCall
+      nodeUser
+      nodePwd
+      "getblock"
+      [Number bh, Number $ SC.scientific 1 0]
   let content = getResponseBody blockInfo :: RpcResponse BlockResponse
   if isNothing (err content)
     then return $ result content

From fb600aa5fc8408a7a9655f0957c2822f6caf969d Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Thu, 28 Sep 2023 13:26:24 -0500
Subject: [PATCH 14/57] Correct data type for `getblock`

---
 src/ZGoBackend.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index 7cfe0c0..c3604ed 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -1803,14 +1803,14 @@ generateToken = do
   runCryptoRNGT rngState $ randomString 24 "abcdef0123456789"
 
 getBlockInfo ::
-     BS.ByteString -> BS.ByteString -> SC.Scientific -> IO (Maybe BlockResponse)
+     BS.ByteString -> BS.ByteString -> T.Text -> IO (Maybe BlockResponse)
 getBlockInfo nodeUser nodePwd bh = do
   blockInfo <-
     makeZcashCall
       nodeUser
       nodePwd
       "getblock"
-      [Number bh, Number $ SC.scientific 1 0]
+      [Data.Aeson.String bh, Number $ SC.scientific 1 0]
   let content = getResponseBody blockInfo :: RpcResponse BlockResponse
   if isNothing (err content)
     then return $ result content
@@ -1825,7 +1825,7 @@ scanTxNative pipe db nodeUser nodePwd = do
     let ownerList = cast' . Doc <$> keyOwnerList
     let keyList = map (maybe "" oviewkey) ownerList
     lastBlockData <- access pipe master db findBlock
-    latestBlock <- getBlockInfo nodeUser nodePwd (SC.scientific (-1) 0)
+    latestBlock <- getBlockInfo nodeUser nodePwd "-1"
     case latestBlock of
       Nothing -> fail "No block data from node"
       Just lB -> do
@@ -1833,7 +1833,7 @@ scanTxNative pipe db nodeUser nodePwd = do
           Nothing -> do
             blockList <-
               mapM
-                (getBlockInfo nodeUser nodePwd . fromInteger)
+                (getBlockInfo nodeUser nodePwd . T.pack . show)
                 [2220000 .. (bl_height lB)]
             let filteredBlockList = filter filterBlock blockList
             let txIdList = concatMap extractTxs filteredBlockList

From 181f4bb74901d82cbb12122d38322dc975774884 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Thu, 28 Sep 2023 13:29:16 -0500
Subject: [PATCH 15/57] Update base block for first run

---
 src/ZGoBackend.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index c3604ed..16f3298 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -1834,7 +1834,7 @@ scanTxNative pipe db nodeUser nodePwd = do
             blockList <-
               mapM
                 (getBlockInfo nodeUser nodePwd . T.pack . show)
-                [2220000 .. (bl_height lB)]
+                [2243000 .. (bl_height lB)]
             let filteredBlockList = filter filterBlock blockList
             let txIdList = concatMap extractTxs filteredBlockList
             txList <- mapM (getTxData nodeUser nodePwd) txIdList

From b36f1240b0889a456621a68d68798eed920b830e Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Thu, 28 Sep 2023 13:37:23 -0500
Subject: [PATCH 16/57] Correct call to `getrawtransaction`

---
 src/ZGoBackend.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index 16f3298..887dfff 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -1861,7 +1861,7 @@ scanTxNative pipe db nodeUser nodePwd = do
           nodeUser
           nodePwd
           "getrawtransaction"
-          [Data.Aeson.String txid]
+          [Data.Aeson.String txid, Number $ SC.scientific 1 0]
       let content = getResponseBody txInfo :: RpcResponse RawTxResponse
       if isNothing (err content)
         then return $ result content

From 0f4a5f547fab3910df41b364f33502d39e18a404 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Thu, 28 Sep 2023 13:59:07 -0500
Subject: [PATCH 17/57] Update deps to latest version of `zcash-haskell`

---
 stack.yaml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/stack.yaml b/stack.yaml
index 5777d09..94406fd 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -45,7 +45,7 @@ extra-deps:
   - git: https://github.com/reach-sh/haskell-hexstring.git
     commit: 085c16fb21b9f856a435a3faab980e7e0b319341
   - git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
-    commit: d78c269d96fe7d8a626cf701b8051c40f251e232
+    commit: cbbbaa0fd0af4c7fc430e1d98c843cd519faa0c5
   - git: https://git.vergara.tech/Vergara_Tech/haskell-foreign-rust.git
     commit: 787c2e813eb3a5d16c375d4b37dfefbd2adcdf05
   - git: https://github.com/well-typed/borsh.git

From 82f6535765364a3e1055801d3609802d1cbb86cf Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Thu, 28 Sep 2023 14:26:49 -0500
Subject: [PATCH 18/57] Update `zcash-haskell` dependency

---
 stack.yaml      | 2 +-
 stack.yaml.lock | 6 +++---
 2 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/stack.yaml b/stack.yaml
index 94406fd..456436b 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -45,7 +45,7 @@ extra-deps:
   - git: https://github.com/reach-sh/haskell-hexstring.git
     commit: 085c16fb21b9f856a435a3faab980e7e0b319341
   - git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
-    commit: cbbbaa0fd0af4c7fc430e1d98c843cd519faa0c5
+    commit: a6a69ae4cc83f18228c20da6c1b34151c6ebd36e
   - git: https://git.vergara.tech/Vergara_Tech/haskell-foreign-rust.git
     commit: 787c2e813eb3a5d16c375d4b37dfefbd2adcdf05
   - git: https://github.com/well-typed/borsh.git
diff --git a/stack.yaml.lock b/stack.yaml.lock
index 0a0dddd..22a8d57 100644
--- a/stack.yaml.lock
+++ b/stack.yaml.lock
@@ -16,15 +16,15 @@ packages:
     commit: 085c16fb21b9f856a435a3faab980e7e0b319341
     git: https://github.com/reach-sh/haskell-hexstring.git
 - completed:
-    commit: d78c269d96fe7d8a626cf701b8051c40f251e232
+    commit: a6a69ae4cc83f18228c20da6c1b34151c6ebd36e
     git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
     name: zcash-haskell
     pantry-tree:
-      sha256: 69201a27ac966be478ef0b8e3fa8e8bf5cbcc67a58cd254326545eb4f3e93569
+      sha256: 73bc6593bfb26f61b63bf51206c8d9b1ecc51b78741df23d4940c9ff69c1aa05
       size: 1229
     version: 0.2.0
   original:
-    commit: d78c269d96fe7d8a626cf701b8051c40f251e232
+    commit: a6a69ae4cc83f18228c20da6c1b34151c6ebd36e
     git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
 - completed:
     commit: 787c2e813eb3a5d16c375d4b37dfefbd2adcdf05

From ae5606f4be71d9cba065771210ea61a2bc3b1851 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Thu, 28 Sep 2023 14:52:10 -0500
Subject: [PATCH 19/57] Update dep on `zcash-haskell`

---
 stack.yaml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/stack.yaml b/stack.yaml
index 456436b..542250d 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -45,7 +45,7 @@ extra-deps:
   - git: https://github.com/reach-sh/haskell-hexstring.git
     commit: 085c16fb21b9f856a435a3faab980e7e0b319341
   - git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
-    commit: a6a69ae4cc83f18228c20da6c1b34151c6ebd36e
+    commit: 697ce83f7c3db28e691ae0924c4857511aa96ac7
   - git: https://git.vergara.tech/Vergara_Tech/haskell-foreign-rust.git
     commit: 787c2e813eb3a5d16c375d4b37dfefbd2adcdf05
   - git: https://github.com/well-typed/borsh.git

From 5f32fd1142d7741ca06c10c107b48fe2eae2828c Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Thu, 28 Sep 2023 15:17:41 -0500
Subject: [PATCH 20/57] Correct the Sapling decoding

---
 src/ZGoBackend.hs | 11 +++++++++--
 stack.yaml.lock   |  6 +++---
 2 files changed, 12 insertions(+), 5 deletions(-)

diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index 887dfff..62eda60 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -1824,6 +1824,7 @@ scanTxNative pipe db nodeUser nodePwd = do
   unless (null keyOwnerList) $ do
     let ownerList = cast' . Doc <$> keyOwnerList
     let keyList = map (maybe "" oviewkey) ownerList
+    print keyList
     lastBlockData <- access pipe master db findBlock
     latestBlock <- getBlockInfo nodeUser nodePwd "-1"
     case latestBlock of
@@ -1831,19 +1832,24 @@ scanTxNative pipe db nodeUser nodePwd = do
       Just lB -> do
         case cast' . Doc =<< lastBlockData of
           Nothing -> do
+            print "Getting blocks"
             blockList <-
               mapM
                 (getBlockInfo nodeUser nodePwd . T.pack . show)
                 [2243000 .. (bl_height lB)]
+            print "filtering blocks..."
             let filteredBlockList = filter filterBlock blockList
+            print "extracting txs from blocks..."
             let txIdList = concatMap extractTxs filteredBlockList
+            print "getting tx data from node..."
             txList <- mapM (getTxData nodeUser nodePwd) txIdList
+            print "filtering txs..."
             let filteredTxList = map fromJust $ filter filterTx txList
+            print "checking txs against keys..."
             mapM_ (checkTx filteredTxList) keyList
           Just lastBlock -> do
             let blockList' = [(bl_height lastBlock + 1) .. (bl_height lB)]
             print blockList'
-    print keyList
   where
     filterBlock :: Maybe BlockResponse -> Bool
     filterBlock b = maybe 0 bl_confirmations b >= 5
@@ -1872,9 +1878,10 @@ scanTxNative pipe db nodeUser nodePwd = do
     checkTx txList k = do
       if isValidSaplingViewingKey (E.encodeUtf8 k)
         then do
+          print "decoding Sapling tx"
           let decodedTxList =
                 map
-                  (decodeSaplingOutput (E.encodeUtf8 k))
+                  (decodeSaplingOutput (bytes (decodeBech32 $ E.encodeUtf8 k)))
                   (concatMap
                      rt_shieldedOutputs
                      (filter (\x -> rt_shieldedOutputs x /= []) txList))
diff --git a/stack.yaml.lock b/stack.yaml.lock
index 22a8d57..7ed10a7 100644
--- a/stack.yaml.lock
+++ b/stack.yaml.lock
@@ -16,15 +16,15 @@ packages:
     commit: 085c16fb21b9f856a435a3faab980e7e0b319341
     git: https://github.com/reach-sh/haskell-hexstring.git
 - completed:
-    commit: a6a69ae4cc83f18228c20da6c1b34151c6ebd36e
+    commit: 697ce83f7c3db28e691ae0924c4857511aa96ac7
     git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
     name: zcash-haskell
     pantry-tree:
-      sha256: 73bc6593bfb26f61b63bf51206c8d9b1ecc51b78741df23d4940c9ff69c1aa05
+      sha256: 5b3ed1888cf157fa7f0b5a73b60468a767635379b94c1e1a00b04f86b4013208
       size: 1229
     version: 0.2.0
   original:
-    commit: a6a69ae4cc83f18228c20da6c1b34151c6ebd36e
+    commit: 697ce83f7c3db28e691ae0924c4857511aa96ac7
     git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
 - completed:
     commit: 787c2e813eb3a5d16c375d4b37dfefbd2adcdf05

From f0d1e933c67357969110b42320cf73e18f18e02a Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Thu, 28 Sep 2023 15:26:56 -0500
Subject: [PATCH 21/57] Add debugging for shielded decode

---
 src/ZGoBackend.hs | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index 62eda60..c6b08d7 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -1879,6 +1879,11 @@ scanTxNative pipe db nodeUser nodePwd = do
       if isValidSaplingViewingKey (E.encodeUtf8 k)
         then do
           print "decoding Sapling tx"
+          let i =
+                concatMap
+                  rt_shieldedOutputs
+                  (filter (\y -> rt_shieldedOutputs y /= []) txList)
+          print i
           let decodedTxList =
                 map
                   (decodeSaplingOutput (bytes (decodeBech32 $ E.encodeUtf8 k)))

From 78c8b9ef5c6ec1c9cee7c9bdb266286424ecddaa Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Thu, 28 Sep 2023 15:35:17 -0500
Subject: [PATCH 22/57] Update Sapling decoding

---
 src/ZGoBackend.hs | 9 ++-------
 1 file changed, 2 insertions(+), 7 deletions(-)

diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index c6b08d7..9068e7d 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -1879,17 +1879,12 @@ scanTxNative pipe db nodeUser nodePwd = do
       if isValidSaplingViewingKey (E.encodeUtf8 k)
         then do
           print "decoding Sapling tx"
-          let i =
-                concatMap
-                  rt_shieldedOutputs
-                  (filter (\y -> rt_shieldedOutputs y /= []) txList)
+          let i = concatMap rt_shieldedOutputs txList
           print i
           let decodedTxList =
                 map
                   (decodeSaplingOutput (bytes (decodeBech32 $ E.encodeUtf8 k)))
-                  (concatMap
-                     rt_shieldedOutputs
-                     (filter (\x -> rt_shieldedOutputs x /= []) txList))
+                  (concatMap rt_shieldedOutputs txList)
           print decodedTxList
         else do
           let vk = decodeUfvk $ E.encodeUtf8 k

From d90f7cdfea3fe662f25046c0cb9167731acb41b3 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Thu, 28 Sep 2023 15:49:05 -0500
Subject: [PATCH 23/57] Troubleshoot the Sapling decode

---
 src/ZGoBackend.hs | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index 9068e7d..ecbd066 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -1879,11 +1879,13 @@ scanTxNative pipe db nodeUser nodePwd = do
       if isValidSaplingViewingKey (E.encodeUtf8 k)
         then do
           print "decoding Sapling tx"
+          let rawKey = decodeBech32 $ E.encodeUtf8 k
+          print rawKey
           let i = concatMap rt_shieldedOutputs txList
           print i
           let decodedTxList =
                 map
-                  (decodeSaplingOutput (bytes (decodeBech32 $ E.encodeUtf8 k)))
+                  (decodeSaplingOutput $ bytes rawKey)
                   (concatMap rt_shieldedOutputs txList)
           print decodedTxList
         else do

From af22c0d71ffb36d68ca2a5d6c4616ccaaa738616 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Thu, 28 Sep 2023 15:55:39 -0500
Subject: [PATCH 24/57] Further troubleshooting

---
 src/ZGoBackend.hs | 16 ++++------------
 1 file changed, 4 insertions(+), 12 deletions(-)

diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index ecbd066..1b763fa 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -1875,19 +1875,11 @@ scanTxNative pipe db nodeUser nodePwd = do
           print $ err content
           return Nothing
     checkTx :: [RawTxResponse] -> T.Text -> IO ()
-    checkTx txList k = do
+    checkTx txList' k = do
       if isValidSaplingViewingKey (E.encodeUtf8 k)
         then do
           print "decoding Sapling tx"
-          let rawKey = decodeBech32 $ E.encodeUtf8 k
-          print rawKey
-          let i = concatMap rt_shieldedOutputs txList
-          print i
-          let decodedTxList =
-                map
-                  (decodeSaplingOutput $ bytes rawKey)
-                  (concatMap rt_shieldedOutputs txList)
-          print decodedTxList
+          print txList'
         else do
           let vk = decodeUfvk $ E.encodeUtf8 k
           case vk of
@@ -1896,12 +1888,12 @@ scanTxNative pipe db nodeUser nodePwd = do
               let decodedSapList =
                     map
                       (decodeSaplingOutput (s_key v))
-                      (concatMap rt_shieldedOutputs txList)
+                      (concatMap rt_shieldedOutputs txList')
               print decodedSapList
               let decodedOrchList =
                     map
                       (decryptOrchardAction v)
-                      (concatMap rt_orchardActions txList)
+                      (concatMap rt_orchardActions txList')
               print decodedOrchList
 
 debug = flip trace

From 3ed60ae2ddf3eac6d6575ee68b6e07e700dcbf28 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Fri, 29 Sep 2023 13:30:14 -0500
Subject: [PATCH 25/57] Update version of `zcash-haskell`

---
 stack.yaml      | 2 +-
 stack.yaml.lock | 6 +++---
 2 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/stack.yaml b/stack.yaml
index 542250d..8496a08 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -45,7 +45,7 @@ extra-deps:
   - git: https://github.com/reach-sh/haskell-hexstring.git
     commit: 085c16fb21b9f856a435a3faab980e7e0b319341
   - git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
-    commit: 697ce83f7c3db28e691ae0924c4857511aa96ac7
+    commit: 31579a6bb23f4c7473c528f6f377ac5ba71f2905
   - git: https://git.vergara.tech/Vergara_Tech/haskell-foreign-rust.git
     commit: 787c2e813eb3a5d16c375d4b37dfefbd2adcdf05
   - git: https://github.com/well-typed/borsh.git
diff --git a/stack.yaml.lock b/stack.yaml.lock
index 7ed10a7..1ed6e1f 100644
--- a/stack.yaml.lock
+++ b/stack.yaml.lock
@@ -16,15 +16,15 @@ packages:
     commit: 085c16fb21b9f856a435a3faab980e7e0b319341
     git: https://github.com/reach-sh/haskell-hexstring.git
 - completed:
-    commit: 697ce83f7c3db28e691ae0924c4857511aa96ac7
+    commit: 31579a6bb23f4c7473c528f6f377ac5ba71f2905
     git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
     name: zcash-haskell
     pantry-tree:
-      sha256: 5b3ed1888cf157fa7f0b5a73b60468a767635379b94c1e1a00b04f86b4013208
+      sha256: 9e22f756d096a63197362c5daa518441080a2c824c8ef7295a21b665db588e73
       size: 1229
     version: 0.2.0
   original:
-    commit: 697ce83f7c3db28e691ae0924c4857511aa96ac7
+    commit: 31579a6bb23f4c7473c528f6f377ac5ba71f2905
     git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
 - completed:
     commit: 787c2e813eb3a5d16c375d4b37dfefbd2adcdf05

From 0224db19934f8ff847233cb81f58500c6e08654b Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Fri, 29 Sep 2023 13:49:34 -0500
Subject: [PATCH 26/57] Implement Sapling decoding

---
 src/ZGoBackend.hs | 14 ++++++++------
 1 file changed, 8 insertions(+), 6 deletions(-)

diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index 1b763fa..00fad1a 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -1836,7 +1836,7 @@ scanTxNative pipe db nodeUser nodePwd = do
             blockList <-
               mapM
                 (getBlockInfo nodeUser nodePwd . T.pack . show)
-                [2243000 .. (bl_height lB)]
+                [((bl_height lB) - 50) .. (bl_height lB)]
             print "filtering blocks..."
             let filteredBlockList = filter filterBlock blockList
             print "extracting txs from blocks..."
@@ -1876,19 +1876,21 @@ scanTxNative pipe db nodeUser nodePwd = do
           return Nothing
     checkTx :: [RawTxResponse] -> T.Text -> IO ()
     checkTx txList' k = do
+      let sOutList = concatMap rt_shieldedOutputs txList'
       if isValidSaplingViewingKey (E.encodeUtf8 k)
         then do
           print "decoding Sapling tx"
-          print txList'
+          let decodedSapList' =
+                map
+                  (decodeSaplingOutput (bytes (decodeBech32 $ E.encodeUtf8 k)))
+                  sOutList
+          print decodedSapList'
         else do
           let vk = decodeUfvk $ E.encodeUtf8 k
           case vk of
             Nothing -> print "Not a valid key"
             Just v -> do
-              let decodedSapList =
-                    map
-                      (decodeSaplingOutput (s_key v))
-                      (concatMap rt_shieldedOutputs txList')
+              let decodedSapList = map (decodeSaplingOutput (s_key v)) sOutList
               print decodedSapList
               let decodedOrchList =
                     map

From 74ba9d23f0b0037621a348b236b35bce63724cb7 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Fri, 29 Sep 2023 14:15:17 -0500
Subject: [PATCH 27/57] Update to next version of `zcash-haskell`

---
 stack.yaml      | 2 +-
 stack.yaml.lock | 6 +++---
 2 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/stack.yaml b/stack.yaml
index 8496a08..9d16d0d 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -45,7 +45,7 @@ extra-deps:
   - git: https://github.com/reach-sh/haskell-hexstring.git
     commit: 085c16fb21b9f856a435a3faab980e7e0b319341
   - git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
-    commit: 31579a6bb23f4c7473c528f6f377ac5ba71f2905
+    commit: 00090dbfcd511895c2d6b9cced6d55545c4d4db7
   - git: https://git.vergara.tech/Vergara_Tech/haskell-foreign-rust.git
     commit: 787c2e813eb3a5d16c375d4b37dfefbd2adcdf05
   - git: https://github.com/well-typed/borsh.git
diff --git a/stack.yaml.lock b/stack.yaml.lock
index 1ed6e1f..a782c3f 100644
--- a/stack.yaml.lock
+++ b/stack.yaml.lock
@@ -16,15 +16,15 @@ packages:
     commit: 085c16fb21b9f856a435a3faab980e7e0b319341
     git: https://github.com/reach-sh/haskell-hexstring.git
 - completed:
-    commit: 31579a6bb23f4c7473c528f6f377ac5ba71f2905
+    commit: 00090dbfcd511895c2d6b9cced6d55545c4d4db7
     git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
     name: zcash-haskell
     pantry-tree:
-      sha256: 9e22f756d096a63197362c5daa518441080a2c824c8ef7295a21b665db588e73
+      sha256: 911ef15253ed951762f45154f45adb97df926fade2e94d758af3032481591d53
       size: 1229
     version: 0.2.0
   original:
-    commit: 31579a6bb23f4c7473c528f6f377ac5ba71f2905
+    commit: 00090dbfcd511895c2d6b9cced6d55545c4d4db7
     git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
 - completed:
     commit: 787c2e813eb3a5d16c375d4b37dfefbd2adcdf05

From d235c56cfb227d31e56fb3500950f946d9783510 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Fri, 29 Sep 2023 14:33:17 -0500
Subject: [PATCH 28/57] Correct tx filtering

---
 src/ZGoBackend.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index 00fad1a..31c51b8 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -1855,7 +1855,7 @@ scanTxNative pipe db nodeUser nodePwd = do
     filterBlock b = maybe 0 bl_confirmations b >= 5
     filterTx :: Maybe RawTxResponse -> Bool
     filterTx t =
-      not (null (maybe [] rt_shieldedOutputs t)) &&
+      not (null (maybe [] rt_shieldedOutputs t)) ||
       not (null (maybe [] rt_orchardActions t))
     extractTxs :: Maybe BlockResponse -> [T.Text]
     extractTxs = maybe [] bl_txs

From cd259f244a903ee8fd59ffac340a973eee077a27 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Mon, 2 Oct 2023 15:27:59 -0500
Subject: [PATCH 29/57] Update version of `zcash-haskell`

---
 stack.yaml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/stack.yaml b/stack.yaml
index 9d16d0d..834e1e9 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -45,7 +45,7 @@ extra-deps:
   - git: https://github.com/reach-sh/haskell-hexstring.git
     commit: 085c16fb21b9f856a435a3faab980e7e0b319341
   - git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
-    commit: 00090dbfcd511895c2d6b9cced6d55545c4d4db7
+    commit: 7992e5bfbe4e747d702f5bc6e27d85a7a9041ba4
   - git: https://git.vergara.tech/Vergara_Tech/haskell-foreign-rust.git
     commit: 787c2e813eb3a5d16c375d4b37dfefbd2adcdf05
   - git: https://github.com/well-typed/borsh.git

From bf740857b392b2fe223824c4a5c397f4d3451c6b Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Tue, 3 Oct 2023 10:47:54 -0500
Subject: [PATCH 30/57] Modify tx scanner to generate ZcashTx

---
 src/ZGoBackend.hs | 35 +++++++++++++++++++++++++++++++----
 stack.yaml.lock   |  6 +++---
 2 files changed, 34 insertions(+), 7 deletions(-)

diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index 31c51b8..113cd48 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -69,6 +69,7 @@ import ZcashHaskell.Orchard
 import ZcashHaskell.Sapling
 import ZcashHaskell.Types
   ( BlockResponse(..)
+  , DecodedNote(..)
   , RawData(..)
   , RawTxResponse(..)
   , RpcCall(..)
@@ -1880,10 +1881,7 @@ scanTxNative pipe db nodeUser nodePwd = do
       if isValidSaplingViewingKey (E.encodeUtf8 k)
         then do
           print "decoding Sapling tx"
-          let decodedSapList' =
-                map
-                  (decodeSaplingOutput (bytes (decodeBech32 $ E.encodeUtf8 k)))
-                  sOutList
+          let decodedSapList' = map (decodeSaplingTx k) txList'
           print decodedSapList'
         else do
           let vk = decodeUfvk $ E.encodeUtf8 k
@@ -1897,6 +1895,35 @@ scanTxNative pipe db nodeUser nodePwd = do
                       (decryptOrchardAction v)
                       (concatMap rt_orchardActions txList')
               print decodedOrchList
+    decodeSaplingTx :: T.Text -> RawTxResponse -> [ZcashTx]
+    decodeSaplingTx k t =
+      map
+        (buildZcashTx t .
+         decodeSaplingOutput (bytes (decodeBech32 $ E.encodeUtf8 k)))
+        (rt_shieldedOutputs t)
+    buildZcashTx :: RawTxResponse -> Maybe DecodedNote -> ZcashTx
+    buildZcashTx t n =
+      case n of
+        Nothing ->
+          ZcashTx
+            (rt_id t)
+            0.0
+            0
+            (rt_blockheight t)
+            (rt_blocktime t)
+            True
+            (rt_confirmations t)
+            ""
+        Just n ->
+          ZcashTx
+            (rt_id t)
+            (fromIntegral (a_value n) * 0.00000001)
+            (toInteger $ a_value n)
+            (rt_blockheight t)
+            (rt_blocktime t)
+            False
+            (rt_confirmations t)
+            (E.decodeUtf8Lenient $ a_memo n)
 
 debug = flip trace
 
diff --git a/stack.yaml.lock b/stack.yaml.lock
index a782c3f..ffc2283 100644
--- a/stack.yaml.lock
+++ b/stack.yaml.lock
@@ -16,15 +16,15 @@ packages:
     commit: 085c16fb21b9f856a435a3faab980e7e0b319341
     git: https://github.com/reach-sh/haskell-hexstring.git
 - completed:
-    commit: 00090dbfcd511895c2d6b9cced6d55545c4d4db7
+    commit: 7992e5bfbe4e747d702f5bc6e27d85a7a9041ba4
     git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
     name: zcash-haskell
     pantry-tree:
-      sha256: 911ef15253ed951762f45154f45adb97df926fade2e94d758af3032481591d53
+      sha256: d84e098e80f7c9b682ef798702fcbfcd884947abc7661b18882d70fd1ad92c7a
       size: 1229
     version: 0.2.0
   original:
-    commit: 00090dbfcd511895c2d6b9cced6d55545c4d4db7
+    commit: 7992e5bfbe4e747d702f5bc6e27d85a7a9041ba4
     git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
 - completed:
     commit: 787c2e813eb3a5d16c375d4b37dfefbd2adcdf05

From 493d17abfdc3171fd693dfe8b363fe741e82e301 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Tue, 3 Oct 2023 11:07:01 -0500
Subject: [PATCH 31/57] Improve decoding of Txs

---
 src/ZGoBackend.hs | 20 ++++++--------------
 1 file changed, 6 insertions(+), 14 deletions(-)

diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index 113cd48..7d9de60 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -1881,8 +1881,8 @@ scanTxNative pipe db nodeUser nodePwd = do
       if isValidSaplingViewingKey (E.encodeUtf8 k)
         then do
           print "decoding Sapling tx"
-          let decodedSapList' = map (decodeSaplingTx k) txList'
-          print decodedSapList'
+          let decodedSapList' = concatMap (decodeSaplingTx k) txList'
+          print $ filter isJust decodedSapList'
         else do
           let vk = decodeUfvk $ E.encodeUtf8 k
           case vk of
@@ -1895,26 +1895,18 @@ scanTxNative pipe db nodeUser nodePwd = do
                       (decryptOrchardAction v)
                       (concatMap rt_orchardActions txList')
               print decodedOrchList
-    decodeSaplingTx :: T.Text -> RawTxResponse -> [ZcashTx]
+    decodeSaplingTx :: T.Text -> RawTxResponse -> [Maybe ZcashTx]
     decodeSaplingTx k t =
       map
         (buildZcashTx t .
          decodeSaplingOutput (bytes (decodeBech32 $ E.encodeUtf8 k)))
         (rt_shieldedOutputs t)
-    buildZcashTx :: RawTxResponse -> Maybe DecodedNote -> ZcashTx
+    buildZcashTx :: RawTxResponse -> Maybe DecodedNote -> Maybe ZcashTx
     buildZcashTx t n =
       case n of
-        Nothing ->
-          ZcashTx
-            (rt_id t)
-            0.0
-            0
-            (rt_blockheight t)
-            (rt_blocktime t)
-            True
-            (rt_confirmations t)
-            ""
+        Nothing -> Nothing
         Just n ->
+          Just $
           ZcashTx
             (rt_id t)
             (fromIntegral (a_value n) * 0.00000001)

From 3f3cb9ef7c62d8ea4bcbe43351b929571eb436a4 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Wed, 4 Oct 2023 11:19:11 -0500
Subject: [PATCH 32/57] Remove call to `zcashd` to validate VK

---
 src/ZGoBackend.hs | 21 ++-------------------
 1 file changed, 2 insertions(+), 19 deletions(-)

diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index 7d9de60..9250006 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -1186,25 +1186,8 @@ routes pipe config = do
                          Nothing -> status badRequest400
                          Just o' -> do
                            unless (oviewkey o' /= "") $ do
-                             vkInfo <-
-                               liftAndCatchIO $
-                               makeZcashCall
-                                 nodeUser
-                                 nodePwd
-                                 "z_importviewingkey"
-                                 [ Data.Aeson.String (T.strip . T.pack $ q)
-                                 , "no"
-                                 ] -- TODO: Remove this call to the node
-                             let content =
-                                   getResponseBody vkInfo :: RpcResponse Object
-                             if isNothing (err content)
-                               then do
-                                 _ <-
-                                   liftAndCatchIO $ run (upsertViewingKey o' q)
-                                 status created201
-                               else do
-                                 text $ L.pack . show $ err content
-                                 status badRequest400
+                             liftAndCatchIO $ run (upsertViewingKey o' q)
+                             status created201
                      else status forbidden403
               else status badRequest400 -- TODO: add Unified VK support
     --Get items associated with the given address

From 68285fbc39424cb9e8238199c5fc7aee0d149d80 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Wed, 4 Oct 2023 14:09:49 -0500
Subject: [PATCH 33/57] Update to next `zcash_haskell` version

---
 stack.yaml      | 2 +-
 stack.yaml.lock | 6 +++---
 2 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/stack.yaml b/stack.yaml
index 834e1e9..90f0c8e 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -45,7 +45,7 @@ extra-deps:
   - git: https://github.com/reach-sh/haskell-hexstring.git
     commit: 085c16fb21b9f856a435a3faab980e7e0b319341
   - git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
-    commit: 7992e5bfbe4e747d702f5bc6e27d85a7a9041ba4
+    commit: 1d558fc646a7758d60a721124812070de222c2e1
   - git: https://git.vergara.tech/Vergara_Tech/haskell-foreign-rust.git
     commit: 787c2e813eb3a5d16c375d4b37dfefbd2adcdf05
   - git: https://github.com/well-typed/borsh.git
diff --git a/stack.yaml.lock b/stack.yaml.lock
index ffc2283..8cc2c00 100644
--- a/stack.yaml.lock
+++ b/stack.yaml.lock
@@ -16,15 +16,15 @@ packages:
     commit: 085c16fb21b9f856a435a3faab980e7e0b319341
     git: https://github.com/reach-sh/haskell-hexstring.git
 - completed:
-    commit: 7992e5bfbe4e747d702f5bc6e27d85a7a9041ba4
+    commit: 1d558fc646a7758d60a721124812070de222c2e1
     git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
     name: zcash-haskell
     pantry-tree:
-      sha256: d84e098e80f7c9b682ef798702fcbfcd884947abc7661b18882d70fd1ad92c7a
+      sha256: eab3c6817bb3cb5738725824d16eb023cb2967ef3bbaa8f8252524602f606dbb
       size: 1229
     version: 0.2.0
   original:
-    commit: 7992e5bfbe4e747d702f5bc6e27d85a7a9041ba4
+    commit: 1d558fc646a7758d60a721124812070de222c2e1
     git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
 - completed:
     commit: 787c2e813eb3a5d16c375d4b37dfefbd2adcdf05

From cd5af6b90757e8d48656700a53ddd98176a76f7c Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Wed, 4 Oct 2023 14:10:13 -0500
Subject: [PATCH 34/57] Add UFVK support for ZGo shops

---
 src/ZGoBackend.hs | 17 ++++++++++++++++-
 1 file changed, 16 insertions(+), 1 deletion(-)

diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index 9250006..fcd0358 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -1189,7 +1189,22 @@ routes pipe config = do
                              liftAndCatchIO $ run (upsertViewingKey o' q)
                              status created201
                      else status forbidden403
-              else status badRequest400 -- TODO: add Unified VK support
+              else case decodeUfvk (C.pack q) of
+                     Nothing -> status badRequest400
+                     Just fvk ->
+                       if matchOrchardAddress
+                            (C.pack q)
+                            (C.pack . T.unpack $ uaddress u')
+                         then do
+                           owner <-
+                             liftAndCatchIO $ run (findOwner $ uaddress u')
+                           case cast' . Doc =<< owner of
+                             Nothing -> status badRequest400
+                             Just o' -> do
+                               unless (oviewkey o' /= "") $ do
+                                 liftAndCatchIO $ run (upsertViewingKey o' q)
+                                 status created201
+                         else status forbidden403
     --Get items associated with the given address
   get "/api/items" $ do
     session <- param "session"

From a2654a6f011abce4c9a4869a1365c422774b1c7d Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Mon, 9 Oct 2023 16:28:17 -0500
Subject: [PATCH 35/57] Correct the Sapling vk call

---
 src/ZGoBackend.hs | 27 ++++++++++++++-------------
 src/ZGoTx.hs      |  2 +-
 test/Spec.hs      | 15 +++++++++------
 3 files changed, 24 insertions(+), 20 deletions(-)

diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index fcd0358..cafe0f7 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -1176,19 +1176,20 @@ routes pipe config = do
         case cast' . Doc =<< u of
           Nothing -> status unauthorized401
           Just u' -> do
-            if isValidSaplingViewingKey qBytes
-              then if matchSaplingAddress
-                        qBytes
-                        (bytes . decodeBech32 . C.pack . T.unpack $ uaddress u')
-                     then do
-                       owner <- liftAndCatchIO $ run (findOwner $ uaddress u')
-                       case cast' . Doc =<< owner of
-                         Nothing -> status badRequest400
-                         Just o' -> do
-                           unless (oviewkey o' /= "") $ do
-                             liftAndCatchIO $ run (upsertViewingKey o' q)
-                             status created201
-                     else status forbidden403
+            if isValidSaplingViewingKey $ C.pack q
+              then do
+                if matchSaplingAddress
+                     qBytes
+                     (bytes . decodeBech32 . C.pack . T.unpack $ uaddress u')
+                  then do
+                    owner <- liftAndCatchIO $ run (findOwner $ uaddress u')
+                    case cast' . Doc =<< owner of
+                      Nothing -> status badRequest400
+                      Just o' -> do
+                        unless (oviewkey o' /= "") $ do
+                          liftAndCatchIO $ run (upsertViewingKey o' q)
+                          status created201
+                  else status forbidden403
               else case decodeUfvk (C.pack q) of
                      Nothing -> status badRequest400
                      Just fvk ->
diff --git a/src/ZGoTx.hs b/src/ZGoTx.hs
index bf7b3d8..e453346 100644
--- a/src/ZGoTx.hs
+++ b/src/ZGoTx.hs
@@ -157,7 +157,7 @@ pMsg = do
 pMemo :: Parser MemoToken
 pMemo = do
   optional $ some spaceChar
-  t <- pSession <|> pSaplingAddress <|> pMsg
+  t <- pSession <|> pSaplingAddress <|> pUnifiedAddress <|> pMsg
   optional $ some spaceChar
   return t
 
diff --git a/test/Spec.hs b/test/Spec.hs
index aadaec1..4e53f46 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -101,8 +101,9 @@ main = do
           case m of
             Left e -> putStrLn $ errorBundlePretty e
             Right m' ->
-              m_session m' `shouldBe`
-              U.fromString "5d3d4494-51c0-432d-8495-050419957aea"
+              m_address m' `shouldBe`
+              Just
+                "u17n7hpwaujyq7ux8f9jpyymtnk5urw7pyrf60smp5mawy7jgz325hfvz3jn3zsfya8yxryf9q7ldk8nu8df0emra5wne28zq9d9nm2pu4x6qwjha565av9aze0xgujgslz74ufkj0c0cylqwjyrh9msjfh7jzal6d3qzrnhkkqy3pqm8j63y07jxj7txqeac982778rmt64f32aum94x"
         it "parse YWallet memo - Orchard" $ do
           let m =
                 runParser
@@ -112,8 +113,9 @@ main = do
           case m of
             Left e -> putStrLn $ errorBundlePretty e
             Right m' ->
-              m_session m' `shouldBe`
-              U.fromString "ad8477d3-4fdd-4c97-90b2-76630b5f77e1"
+              m_address m' `shouldBe`
+              Just
+                "u17n7hpwaujyq7ux8f9jpyymtnk5urw7pyrf60smp5mawy7jgz325hfvz3jn3zsfya8yxryf9q7ldk8nu8df0emra5wne28zq9d9nm2pu4x6qwjha565av9aze0xgujgslz74ufkj0c0cylqwjyrh9msjfh7jzal6d3qzrnhkkqy3pqm8j63y07jxj7txqeac982778rmt64f32aum94x"
         it "parse Zingo memo - Orchard" $ do
           let m =
                 runParser
@@ -123,8 +125,9 @@ main = do
           case m of
             Left e -> putStrLn $ errorBundlePretty e
             Right m' ->
-              m_session m' `shouldBe`
-              U.fromString "5d3d4494-51c0-432d-8495-050419957aea"
+              m_address m' `shouldBe`
+              Just
+                "u17n7hpwaujyq7ux8f9jpyymtnk5urw7pyrf60smp5mawy7jgz325hfvz3jn3zsfya8yxryf9q7ldk8nu8df0emra5wne28zq9d9nm2pu4x6qwjha565av9aze0xgujgslz74ufkj0c0cylqwjyrh9msjfh7jzal6d3qzrnhkkqy3pqm8j63y07jxj7txqeac982778rmt64f32aum94x"
       describe "PIN generator" $ do
         it "should give a 7 digit" $ do
           pin <- generatePin

From f5dbde0ed68c767309a5b9133cfc7e4feebe4405 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Tue, 10 Oct 2023 11:12:58 -0500
Subject: [PATCH 36/57] Improve PIN send

---
 src/ZGoBackend.hs | 9 ++-------
 1 file changed, 2 insertions(+), 7 deletions(-)

diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index cafe0f7..799de62 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -372,12 +372,7 @@ listCountries :: Action IO [Document]
 listCountries = rest =<< find (select [] "countries")
 
 sendPin ::
-     BS.ByteString
-  -> BS.ByteString
-  -> T.Text
-  -> T.Text
-  -> T.Text
-  -> Action IO String
+     BS.ByteString -> BS.ByteString -> T.Text -> T.Text -> T.Text -> IO String
 sendPin nodeUser nodePwd nodeAddress addr pin = do
   let pd =
         [ Data.Aeson.String nodeAddress
@@ -414,7 +409,7 @@ addUser nodeUser nodePwd p db node (Just tx) = do
   isNew <- liftIO $ isUserNew p db tx
   when isNew $ do
     newPin <- liftIO generatePin
-    _ <- sendPin nodeUser nodePwd node (address tx) (T.pack newPin)
+    _ <- liftIO $ sendPin nodeUser nodePwd node (address tx) (T.pack newPin)
     let pinHash =
           BLK.hash
             [ BA.pack . BS.unpack . C.pack . T.unpack $

From b14a5cfb8334b24f083e717f7de010ef530086f4 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Wed, 11 Oct 2023 07:51:16 -0500
Subject: [PATCH 37/57] Improve messaging for PIN send

---
 src/ZGoBackend.hs | 65 ++++++++++++++++++++++++++++++++++++++++++++---
 1 file changed, 61 insertions(+), 4 deletions(-)

diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index 799de62..439c1e6 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -52,6 +52,7 @@ import Numeric
 import Order
 import Owner
 import Payment
+import System.IO
 import System.IO.Unsafe
 import System.Random
 import Test.QuickCheck
@@ -384,17 +385,73 @@ sendPin nodeUser nodePwd nodeAddress addr pin = do
                    , "memo" .= encodeHexText ("ZGo PIN: " <> pin)
                    ]
                ])
+        , Data.Aeson.Number $ SC.scientific 1 1
+        , Data.Aeson.Null
+        , Data.Aeson.String "AllowRevealedAmounts"
         ]
-  r <- liftIO $ try $ makeZcashCall nodeUser nodePwd "z_sendmany" pd --  IO (Either HttpException (Response Object))
+  r <- liftIO $ try $ makeZcashCall nodeUser nodePwd "z_sendmany" pd
   case r of
     Right res -> do
-      let sCode = getResponseStatus (res :: Response Object)
+      let sCode = getResponseStatus (res :: Response (RpcResponse T.Text))
+      let rBody = getResponseBody res
       if sCode == ok200
-        then return "Pin sent!"
+        then do
+          case result rBody of
+            Nothing -> return "Couldn't parse node response"
+            Just x -> do
+              putStr "  Sending."
+              checkOpResult nodeUser nodePwd x
+              return "Pin sent!"
         else return "Pin sending failed :("
     Left ex ->
       return $ "Failed to send tx to node :(" ++ show (ex :: HttpException)
 
+-- | Type for Operation Result
+data OpResult = OpResult
+  { opsuccess :: T.Text
+  , opmessage :: Maybe T.Text
+  , optxid :: Maybe T.Text
+  } deriving (Show, Eq)
+
+instance FromJSON OpResult where
+  parseJSON =
+    withObject "OpResult" $ \obj -> do
+      s <- obj .: "status"
+      r <- obj .:? "result"
+      e <- obj .:? "error"
+      t <-
+        case r of
+          Nothing -> return Nothing
+          Just r' -> r' .: "txid"
+      m <-
+        case e of
+          Nothing -> return Nothing
+          Just m' -> m' .: "message"
+      pure $ OpResult s m t
+
+checkOpResult :: BS.ByteString -> BS.ByteString -> T.Text -> IO ()
+checkOpResult user pwd opid = do
+  response <-
+    makeZcashCall
+      user
+      pwd
+      "z_getoperationstatus"
+      [Data.Aeson.Array (V.fromList [Data.Aeson.String opid])]
+  let rpcResp = getResponseBody response :: (RpcResponse [OpResult])
+  case result rpcResp of
+    Nothing -> putStrLn "Couldn't read response from node"
+    Just opCode -> mapM_ showResult opCode
+  where
+    showResult t =
+      case opsuccess t of
+        "success" ->
+          putStrLn $ "  Success! Tx ID: " ++ maybe "" T.unpack (optxid t)
+        "executing" -> do
+          putStr "."
+          hFlush stdout
+          threadDelay 1000000 >> checkOpResult user pwd opid
+        _ -> putStrLn $ "  Failed :( " ++ maybe "" T.unpack (opmessage t)
+
 -- | Function to create user from ZGoTx
 addUser ::
      BS.ByteString
@@ -1831,7 +1888,7 @@ scanTxNative pipe db nodeUser nodePwd = do
             blockList <-
               mapM
                 (getBlockInfo nodeUser nodePwd . T.pack . show)
-                [((bl_height lB) - 50) .. (bl_height lB)]
+                [(bl_height lB - 50) .. (bl_height lB)]
             print "filtering blocks..."
             let filteredBlockList = filter filterBlock blockList
             print "extracting txs from blocks..."

From ccd9e8280e2af33f2eda76af90eaf639cf095c78 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Wed, 11 Oct 2023 14:25:01 -0500
Subject: [PATCH 38/57] Tests for adding UVK

---
 src/ZGoBackend.hs |  46 ++++++++++++++------
 test/Spec.hs      | 105 +++++++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 136 insertions(+), 15 deletions(-)

diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index 439c1e6..3fe24b3 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -1244,20 +1244,40 @@ routes pipe config = do
                   else status forbidden403
               else case decodeUfvk (C.pack q) of
                      Nothing -> status badRequest400
-                     Just fvk ->
-                       if matchOrchardAddress
-                            (C.pack q)
-                            (C.pack . T.unpack $ uaddress u')
+                     Just fvk -> do
+                       if isValidUnifiedAddress $
+                          C.pack . T.unpack $ uaddress u'
                          then do
-                           owner <-
-                             liftAndCatchIO $ run (findOwner $ uaddress u')
-                           case cast' . Doc =<< owner of
-                             Nothing -> status badRequest400
-                             Just o' -> do
-                               unless (oviewkey o' /= "") $ do
-                                 liftAndCatchIO $ run (upsertViewingKey o' q)
-                                 status created201
-                         else status forbidden403
+                           if matchOrchardAddress
+                                (C.pack q)
+                                (C.pack . T.unpack $ uaddress u')
+                             then do
+                               owner <-
+                                 liftAndCatchIO $ run (findOwner $ uaddress u')
+                               case cast' . Doc =<< owner of
+                                 Nothing -> status badRequest400
+                                 Just o' -> do
+                                   unless (oviewkey o' /= "") $ do
+                                     liftAndCatchIO $
+                                       run (upsertViewingKey o' q)
+                                     status created201
+                             else status forbidden403
+                         else do
+                           if matchSaplingAddress
+                                (s_key fvk)
+                                (bytes . decodeBech32 . C.pack . T.unpack $
+                                 uaddress u')
+                             then do
+                               owner <-
+                                 liftAndCatchIO $ run (findOwner $ uaddress u')
+                               case cast' . Doc =<< owner of
+                                 Nothing -> status badRequest400
+                                 Just o' -> do
+                                   unless (oviewkey o' /= "") $ do
+                                     liftAndCatchIO $
+                                       run (upsertViewingKey o' q)
+                                     status created201
+                             else status forbidden403
     --Get items associated with the given address
   get "/api/items" $ do
     session <- param "session"
diff --git a/test/Spec.hs b/test/Spec.hs
index 4e53f46..e1da300 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -691,6 +691,8 @@ main = do
                 "zxviews1qdjagrrpqqqqpq8es75mlu6rref0qyrstchf8dxzeygtsejwfqu8ckhwl2qj5m8am7lmupxk3vkvdjm8pawjpmesjfapvsqw96pa46c2z0kk7letrxf7mkltwz54fwpxc7kc79mm5kce3rwn5ssl009zwsra2spppwgrx25s9k5hq65f69l4jz2tjmqgy0pl49qmtaj3nudk6wglwe2hpa327hydlchtyq9av6wjd6hu68e04ahwk9a9n2kt0kj3nj99nue65awtu5cwwcpjs"
           let vk2 =
                 "zxviews1qdjagrrpqqqqpq8es75mlufakef0qyrstchf8dxzeygtsejwfqu8ckhwl2qj5m8am7lmupxk3vkvdjm8pawjpmesjfapvsqw96pa46c2z0kk7letrxf7mkltwz54fwpxc7kc79mm5kce3rwn5ssl009zwsra2spppwgrx25s9k5hq65f69l4jz2tjmqgy0pl49qmtaj3nudk6wglwe2hpa327hydlchtyq9av6wjd6hu68e04ahwk9a9n2kt0kj3nj99nue65awtu5cwwcpjs"
+          let vk3 =
+                "uview1u833rp8yykd7h4druwht6xp6k8krle45fx8hqsw6vzw63n24atxpcatws82z092kryazuu6d7rayyut8m36wm4wpjy2z8r9hj48fx5pf49gw4sjrq8503qpz3vqj5hg0vg9vsqeasg5qjuyh94uyfm7v76udqcm2m0wfc25hcyqswcn56xxduq3xkgxkr0l73cjy88fdvf90eq5fda9g6x7yv7d0uckpevxg6540wc76xrc4axxvlt03ptaa2a0rektglmdy68656f3uzcdgqqyu0t7wk5cvwghyyvgqc0rp3vgu5ye4nd236ml57rjh083a2755qemf6dk6pw0qrnfm7246s8eg2hhzkzpf9h73chhng7xhmyem2sjh8rs2m9nhfcslsgenm"
           it "returns 401 with bad session" $ do
             req <-
               testPostJson "/api/ownervk" $
@@ -731,7 +733,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)]
@@ -741,6 +743,26 @@ 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
@@ -1179,8 +1201,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
@@ -1236,6 +1275,60 @@ startAPI config = do
           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
+          ""
+          ""
+  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
+          ""
+          ""
   _ <- access pipe master "test" (Database.MongoDB.delete (select [] "owners"))
   let o = val myOwner
   case o of
@@ -1245,6 +1338,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 =

From d7ced42d86c1bc4330e95ce55cc9241de7c43843 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Thu, 12 Oct 2023 14:53:53 -0500
Subject: [PATCH 39/57] Implement saving of scanned txs

---
 src/Owner.hs      |  3 +--
 src/ZGoBackend.hs | 49 +++++++++++++++++++++++++++++++++++------------
 2 files changed, 38 insertions(+), 14 deletions(-)

diff --git a/src/Owner.hs b/src/Owner.hs
index 7985fc7..803fb65 100644
--- a/src/Owner.hs
+++ b/src/Owner.hs
@@ -420,8 +420,7 @@ findExpiringOwners now =
 
 findWithKeys :: Action IO [Document]
 findWithKeys =
-  rest =<<
-  find (select ["paid" =: True, "invoices" =: True, "payconf" =: True] "owners")
+  rest =<< find (select ["paid" =: True, "payconf" =: True] "owners")
 
 removePro :: T.Text -> Action IO ()
 removePro o =
diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index 3fe24b3..d82a89c 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -1890,10 +1890,13 @@ getBlockInfo nodeUser nodePwd bh = do
       print $ err content
       return Nothing
 
-scanTxNative :: Pipe -> T.Text -> BS.ByteString -> BS.ByteString -> IO ()
-scanTxNative pipe db nodeUser nodePwd = do
+scanTxNative :: Config -> Pipe -> IO ()
+scanTxNative config pipe = do
+  let db = c_dbName config
   keyOwnerList <- access pipe master db findWithKeys
   unless (null keyOwnerList) $ do
+    let nodeUser = c_nodeUser config
+    let nodePwd = c_nodePwd config
     let ownerList = cast' . Doc <$> keyOwnerList
     let keyList = map (maybe "" oviewkey) ownerList
     print keyList
@@ -1919,9 +1922,23 @@ scanTxNative pipe db nodeUser nodePwd = do
             let filteredTxList = map fromJust $ filter filterTx txList
             print "checking txs against keys..."
             mapM_ (checkTx filteredTxList) keyList
+            access pipe master (c_dbName config) $ upsertBlock lB
           Just lastBlock -> do
-            let blockList' = [(bl_height lastBlock + 1) .. (bl_height lB)]
-            print blockList'
+            blockList' <-
+              mapM
+                (getBlockInfo nodeUser nodePwd . T.pack . show)
+                [(bl_height lastBlock + 1) .. (bl_height lB)]
+            print "filtering blocks..."
+            let filteredBlockList = filter filterBlock blockList'
+            print "extracting txs from blocks..."
+            let txIdList = concatMap extractTxs filteredBlockList
+            print "getting tx data from node..."
+            txList <- mapM (getTxData nodeUser nodePwd) txIdList
+            print "filtering txs..."
+            let filteredTxList = map fromJust $ filter filterTx txList
+            print "checking txs against keys..."
+            mapM_ (checkTx filteredTxList) keyList
+            access pipe master (c_dbName config) $ upsertBlock lB
   where
     filterBlock :: Maybe BlockResponse -> Bool
     filterBlock b = maybe 0 bl_confirmations b >= 5
@@ -1953,25 +1970,33 @@ scanTxNative pipe db nodeUser nodePwd = do
         then do
           print "decoding Sapling tx"
           let decodedSapList' = concatMap (decodeSaplingTx k) txList'
-          print $ filter isJust decodedSapList'
+          let zList = catMaybes decodedSapList'
+          mapM_ (zToZGoTx' config pipe) zList
         else do
           let vk = decodeUfvk $ E.encodeUtf8 k
           case vk of
             Nothing -> print "Not a valid key"
             Just v -> do
-              let decodedSapList = map (decodeSaplingOutput (s_key v)) sOutList
-              print decodedSapList
-              let decodedOrchList =
-                    map
-                      (decryptOrchardAction v)
-                      (concatMap rt_orchardActions txList')
-              print decodedOrchList
+              let decodedSapList =
+                    concatMap (decodeUnifiedSaplingTx (s_key v)) txList'
+              let zList' = catMaybes decodedSapList
+              mapM_ (zToZGoTx' config pipe) zList'
+              let decodedOrchList = concatMap (decodeUnifiedOrchardTx v) txList'
+              let oList = catMaybes decodedOrchList
+              mapM_ (zToZGoTx' config pipe) oList
     decodeSaplingTx :: T.Text -> RawTxResponse -> [Maybe ZcashTx]
     decodeSaplingTx k t =
       map
         (buildZcashTx t .
          decodeSaplingOutput (bytes (decodeBech32 $ E.encodeUtf8 k)))
         (rt_shieldedOutputs t)
+    decodeUnifiedSaplingTx :: BS.ByteString -> RawTxResponse -> [Maybe ZcashTx]
+    decodeUnifiedSaplingTx k t =
+      map (buildZcashTx t . decodeSaplingOutput k) (rt_shieldedOutputs t)
+    decodeUnifiedOrchardTx ::
+         UnifiedFullViewingKey -> RawTxResponse -> [Maybe ZcashTx]
+    decodeUnifiedOrchardTx k t =
+      map (buildZcashTx t . decryptOrchardAction k) (rt_orchardActions t)
     buildZcashTx :: RawTxResponse -> Maybe DecodedNote -> Maybe ZcashTx
     buildZcashTx t n =
       case n of

From c2be91dfcc9e7ae5acba3693e470485da1b3f840 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Fri, 13 Oct 2023 14:20:10 -0500
Subject: [PATCH 40/57] Add ZGo order parsing and payment tracking

---
 src/ZGoBackend.hs | 104 ++++++++++++++++++++++++++++++++++++++++------
 src/ZGoTx.hs      |  19 ++++++++-
 2 files changed, 109 insertions(+), 14 deletions(-)

diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index d82a89c..2c7b787 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -1897,9 +1897,7 @@ scanTxNative config pipe = do
   unless (null keyOwnerList) $ do
     let nodeUser = c_nodeUser config
     let nodePwd = c_nodePwd config
-    let ownerList = cast' . Doc <$> keyOwnerList
-    let keyList = map (maybe "" oviewkey) ownerList
-    print keyList
+    let ownerList = mapMaybe (cast' . Doc) keyOwnerList
     lastBlockData <- access pipe master db findBlock
     latestBlock <- getBlockInfo nodeUser nodePwd "-1"
     case latestBlock of
@@ -1921,7 +1919,7 @@ scanTxNative config pipe = do
             print "filtering txs..."
             let filteredTxList = map fromJust $ filter filterTx txList
             print "checking txs against keys..."
-            mapM_ (checkTx filteredTxList) keyList
+            mapM_ (checkTx filteredTxList) ownerList
             access pipe master (c_dbName config) $ upsertBlock lB
           Just lastBlock -> do
             blockList' <-
@@ -1937,7 +1935,7 @@ scanTxNative config pipe = do
             print "filtering txs..."
             let filteredTxList = map fromJust $ filter filterTx txList
             print "checking txs against keys..."
-            mapM_ (checkTx filteredTxList) keyList
+            mapM_ (checkTx filteredTxList) ownerList
             access pipe master (c_dbName config) $ upsertBlock lB
   where
     filterBlock :: Maybe BlockResponse -> Bool
@@ -1963,27 +1961,27 @@ scanTxNative config pipe = do
         else do
           print $ err content
           return Nothing
-    checkTx :: [RawTxResponse] -> T.Text -> IO ()
+    checkTx :: [RawTxResponse] -> Owner -> IO ()
     checkTx txList' k = do
       let sOutList = concatMap rt_shieldedOutputs txList'
-      if isValidSaplingViewingKey (E.encodeUtf8 k)
+      if isValidSaplingViewingKey (E.encodeUtf8 $ oviewkey k)
         then do
           print "decoding Sapling tx"
-          let decodedSapList' = concatMap (decodeSaplingTx k) txList'
+          let decodedSapList' = concatMap (decodeSaplingTx $ oviewkey k) txList'
           let zList = catMaybes decodedSapList'
-          mapM_ (zToZGoTx' config pipe) zList
+          mapM_ (recordPayment pipe (c_dbName config) (oaddress k)) zList
         else do
-          let vk = decodeUfvk $ E.encodeUtf8 k
+          let vk = decodeUfvk $ E.encodeUtf8 $ oviewkey k
           case vk of
             Nothing -> print "Not a valid key"
             Just v -> do
               let decodedSapList =
                     concatMap (decodeUnifiedSaplingTx (s_key v)) txList'
               let zList' = catMaybes decodedSapList
-              mapM_ (zToZGoTx' config pipe) zList'
+              mapM_ (recordPayment pipe (c_dbName config) (oaddress k)) zList'
               let decodedOrchList = concatMap (decodeUnifiedOrchardTx v) txList'
               let oList = catMaybes decodedOrchList
-              mapM_ (zToZGoTx' config pipe) oList
+              mapM_ (recordPayment pipe (c_dbName config) (oaddress k)) oList
     decodeSaplingTx :: T.Text -> RawTxResponse -> [Maybe ZcashTx]
     decodeSaplingTx k t =
       map
@@ -2012,6 +2010,88 @@ scanTxNative config pipe = do
             False
             (rt_confirmations t)
             (E.decodeUtf8Lenient $ a_memo n)
+    recordPayment :: Pipe -> T.Text -> T.Text -> ZcashTx -> IO ()
+    recordPayment p dbName z x = do
+      let zM = runParser pZGoMemo (T.unpack . ztxid $ x) (zmemo x)
+      case zM of
+        Right m -> do
+          case m_orderId m of
+            Nothing -> return ()
+            Just orderId -> do
+              o <- access p master dbName $ findOrderById (T.unpack orderId)
+              let xOrder = o >>= (cast' . Doc)
+              case xOrder of
+                Nothing -> error "Failed to retrieve order from database"
+                Just xO ->
+                  when
+                    (not (qpaid xO) &&
+                     qtotalZec xO == zamount x && z == qaddress xO) $ do
+                    let sReg = mkRegex "(.*)-([a-fA-f0-9]{24})"
+                    let sResult = matchAllText sReg (T.unpack $ qsession xO)
+                    if not (null sResult)
+                      then case fst $ head sResult ! 1 of
+                             "Xero" -> do
+                               xeroConfig <- access p master dbName findXero
+                               let xC = xeroConfig >>= (cast' . Doc)
+                               case xC of
+                                 Nothing -> error "Failed to read Xero config"
+                                 Just xConf -> do
+                                   requestXeroToken
+                                     p
+                                     dbName
+                                     xConf
+                                     ""
+                                     (qaddress xO)
+                                   payXeroInvoice
+                                     p
+                                     dbName
+                                     (qexternalInvoice xO)
+                                     (qaddress xO)
+                                     (qtotal xO)
+                                     (qtotalZec xO)
+                                   liftIO $
+                                     access p master dbName $
+                                     markOrderPaid (T.unpack orderId, zamount x)
+                             "WC" -> do
+                               let wOwner = fst $ head sResult ! 2
+                               wooT <-
+                                 access p master dbName $
+                                 findWooToken $ Just (read wOwner)
+                               let wT = wooT >>= (cast' . Doc)
+                               case wT of
+                                 Nothing ->
+                                   error "Failed to read WooCommerce token"
+                                 Just wt -> do
+                                   let iReg = mkRegex "(.*)-(.*)-.*"
+                                   let iResult =
+                                         matchAllText
+                                           iReg
+                                           (T.unpack $ qexternalInvoice xO)
+                                   if not (null iResult)
+                                     then do
+                                       let wUrl =
+                                             E.decodeUtf8With lenientDecode .
+                                             B64.decodeLenient . C.pack $
+                                             fst $ head iResult ! 1
+                                       let iNum = fst $ head iResult ! 2
+                                       payWooOrder
+                                         (T.unpack wUrl)
+                                         (C.pack iNum)
+                                         (C.pack $ maybe "" show (q_id xO))
+                                         (C.pack . T.unpack $ w_token wt)
+                                         (C.pack . show $ qprice xO)
+                                         (C.pack . show $ qtotalZec xO)
+                                       liftIO $
+                                         access p master dbName $
+                                         markOrderPaid
+                                           (T.unpack orderId, zamount x)
+                                     else error
+                                            "Couldn't parse externalInvoice for WooCommerce"
+                             _ -> putStrLn "Not an integration order"
+                      else liftIO $
+                           access p master dbName $
+                           markOrderPaid (T.unpack orderId, zamount x)
+        Left e -> print "Unable to parse order memo"
 
 debug = flip trace
 
diff --git a/src/ZGoTx.hs b/src/ZGoTx.hs
index e453346..3749eb4 100644
--- a/src/ZGoTx.hs
+++ b/src/ZGoTx.hs
@@ -105,6 +105,7 @@ 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
@@ -112,6 +113,7 @@ data MemoToken
   | PayMsg !U.UUID
   | Address !T.Text
   | Msg !T.Text
+  | OrderId !T.Text
   deriving (Show, Eq)
 
 type Parser = Parsec Void T.Text
@@ -146,6 +148,12 @@ pUnifiedAddress = do
     then pure $ Address $ T.pack ("u1" <> a)
     else 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 <-
@@ -157,7 +165,7 @@ pMsg = do
 pMemo :: Parser MemoToken
 pMemo = do
   optional $ some spaceChar
-  t <- pSession <|> pSaplingAddress <|> pUnifiedAddress <|> pMsg
+  t <- pSession <|> pSaplingAddress <|> pUnifiedAddress <|> pOrderId <|> pMsg
   optional $ some spaceChar
   return t
 
@@ -182,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) &&

From a3eb5d29ee861d59a09143908a20ed17fa39a2db Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Fri, 13 Oct 2023 14:45:19 -0500
Subject: [PATCH 41/57] Add debugging

---
 src/ZGoBackend.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index 2c7b787..112ce2a 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -2016,8 +2016,9 @@ scanTxNative config pipe = do
       case zM of
         Right m -> do
           case m_orderId m of
-            Nothing -> return ()
+            Nothing -> print "Not an order Tx"
             Just orderId -> do
+              print orderId
               o <- access p master dbName $ findOrderById (T.unpack orderId)
               let xOrder = o >>= (cast' . Doc)
               case xOrder of

From 4558dfb8da75fae6f46268e002479126d5de4fd8 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Fri, 13 Oct 2023 14:53:33 -0500
Subject: [PATCH 42/57] Add more debugging

---
 src/ZGoBackend.hs | 10 +++++++---
 1 file changed, 7 insertions(+), 3 deletions(-)

diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index 112ce2a..448fff5 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -2089,9 +2089,13 @@ scanTxNative config pipe = do
                                      else error
                                             "Couldn't parse externalInvoice for WooCommerce"
                              _ -> putStrLn "Not an integration order"
-                      else liftIO $
-                           access p master dbName $
-                           markOrderPaid (T.unpack orderId, zamount x)
+                      else do
+                        print $
+                          "Regular order" ++
+                          T.unpack orderId ++ " " ++ show (zamount x)
+                        liftIO $
+                          access p master dbName $
+                          markOrderPaid (T.unpack orderId, zamount x)
         Left e -> print "Unable to parse order memo"
 
 debug = flip trace

From 19b352c38154ebf6c8aa60dbe9f39cad147fc895 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Fri, 13 Oct 2023 14:59:14 -0500
Subject: [PATCH 43/57] Continue debugging

---
 src/ZGoBackend.hs | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index 448fff5..e590bbe 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -2023,7 +2023,11 @@ scanTxNative config pipe = do
               let xOrder = o >>= (cast' . Doc)
               case xOrder of
                 Nothing -> error "Failed to retrieve order from database"
-                Just xO ->
+                Just xO -> do
+                  print $ qtotalZec xO
+                  print $ zamount x
+                  print z
+                  print $ qaddress xO
                   when
                     (not (qpaid xO) &&
                      qtotalZec xO == zamount x && z == qaddress xO) $ do

From ec720155244ba01b243b6c2dd2988a7c5eb0bf39 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Fri, 13 Oct 2023 15:06:08 -0500
Subject: [PATCH 44/57] Correct ZEC calculation

---
 src/ZGoBackend.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index e590bbe..2a332d0 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -2003,7 +2003,7 @@ scanTxNative config pipe = do
           Just $
           ZcashTx
             (rt_id t)
-            (fromIntegral (a_value n) * 0.00000001)
+            (fromIntegral (a_value n) / 100000000)
             (toInteger $ a_value n)
             (rt_blockheight t)
             (rt_blocktime t)

From 5788a26880a0152cf1735414bcd12942f78c4e9b Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Fri, 13 Oct 2023 15:20:01 -0500
Subject: [PATCH 45/57] Enable new native transaction scanning

---
 app/Tasks.hs      |  3 ++-
 src/ZGoBackend.hs | 14 +++-----------
 2 files changed, 5 insertions(+), 12 deletions(-)

diff --git a/app/Tasks.hs b/app/Tasks.hs
index 0f8a12d..62027da 100644
--- a/app/Tasks.hs
+++ b/app/Tasks.hs
@@ -23,7 +23,8 @@ 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
diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index 2a332d0..e3d0882 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -2024,10 +2024,6 @@ scanTxNative config pipe = do
               case xOrder of
                 Nothing -> error "Failed to retrieve order from database"
                 Just xO -> do
-                  print $ qtotalZec xO
-                  print $ zamount x
-                  print z
-                  print $ qaddress xO
                   when
                     (not (qpaid xO) &&
                      qtotalZec xO == zamount x && z == qaddress xO) $ do
@@ -2093,13 +2089,9 @@ scanTxNative config pipe = do
                                      else error
                                             "Couldn't parse externalInvoice for WooCommerce"
                              _ -> putStrLn "Not an integration order"
-                      else do
-                        print $
-                          "Regular order" ++
-                          T.unpack orderId ++ " " ++ show (zamount x)
-                        liftIO $
-                          access p master dbName $
-                          markOrderPaid (T.unpack orderId, zamount x)
+                      else liftIO $
+                           access p master dbName $
+                           markOrderPaid (T.unpack orderId, zamount x)
         Left e -> print "Unable to parse order memo"
 
 debug = flip trace

From ac86d1ee599fda157971c79a210fe4d9e3268a27 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Fri, 13 Oct 2023 15:35:48 -0500
Subject: [PATCH 46/57] Correct block recording

---
 src/ZGoBackend.hs | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index e3d0882..763c512 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -1920,7 +1920,8 @@ scanTxNative config pipe = do
             let filteredTxList = map fromJust $ filter filterTx txList
             print "checking txs against keys..."
             mapM_ (checkTx filteredTxList) ownerList
-            access pipe master (c_dbName config) $ upsertBlock lB
+            access pipe master (c_dbName config) $
+              upsertBlock (last $ catMaybes filteredBlockList)
           Just lastBlock -> do
             blockList' <-
               mapM
@@ -1936,7 +1937,8 @@ scanTxNative config pipe = do
             let filteredTxList = map fromJust $ filter filterTx txList
             print "checking txs against keys..."
             mapM_ (checkTx filteredTxList) ownerList
-            access pipe master (c_dbName config) $ upsertBlock lB
+            access pipe master (c_dbName config) $
+              upsertBlock (last $ catMaybes filteredBlockList)
   where
     filterBlock :: Maybe BlockResponse -> Bool
     filterBlock b = maybe 0 bl_confirmations b >= 5

From 2b2c3ba70e62a0c21a0f940f0f5adec01d28788e Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Mon, 16 Oct 2023 14:57:24 -0500
Subject: [PATCH 47/57] Update order endpoint for improved security

---
 CHANGELOG.md      |  1 +
 src/ZGoBackend.hs | 71 ++++++++++++++++++++++++++++++++++++++---------
 2 files changed, 59 insertions(+), 13 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 2712b8b..cccc5c4 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -15,6 +15,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 
 ### 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.
 
diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index 763c512..7673ea1 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -590,6 +590,7 @@ routes pipe config = do
   let nodeUser = c_nodeUser config
   let nodePwd = c_nodePwd config
   let nodeAddress = c_nodeAddress config
+  let dbName = c_dbName config
   middleware $
     cors $
     const $
@@ -1428,20 +1429,44 @@ routes pipe config = do
     case cast' . Doc =<< user of
       Nothing -> status unauthorized401
       Just u -> do
-        if uaddress u == qaddress q
-          then do
-            if qtoken q == ""
+        dbOrder <-
+          liftAndCatchIO $ run (findOrderById $ maybe "0" show (q_id q))
+        case cast' . Doc =<< dbOrder of
+          Nothing -> do
+            if uaddress u == qaddress q
               then do
-                t <- liftIO generateToken
-                _ <-
-                  liftAndCatchIO $
-                  run (upsertOrder $ setOrderToken (T.pack t) q)
-                status created201
-              else do
-                _ <- liftAndCatchIO $ run (upsertOrder q)
-                status created201
-          else status forbidden403
-    --Delete order
+                if qtoken q == ""
+                  then do
+                    t <- liftIO generateToken
+                    _ <-
+                      liftAndCatchIO $
+                      run (upsertOrder $ setOrderToken (T.pack t) q)
+                    status created201
+                  else do
+                    _ <-
+                      liftAndCatchIO $ access pipe master dbName (upsertOrder q)
+                    status created201
+              else status forbidden403
+          Just dbO -> do
+            if qaddress q == qaddress dbO && qsession q == qsession dbO
+              then do
+                if uaddress u == qaddress q
+                  then do
+                    if qtoken q == ""
+                      then do
+                        t <- liftIO generateToken
+                        _ <-
+                          liftAndCatchIO $
+                          run (upsertOrder $ setOrderToken (T.pack t) q)
+                        status created201
+                      else do
+                        _ <-
+                          liftAndCatchIO $
+                          access pipe master dbName (upsertOrder q)
+                        status created201
+                  else status forbidden403
+              else status forbidden403
+  --Delete order
   Web.Scotty.delete "/api/order/:id" $ do
     oId <- param "id"
     session <- param "session"
@@ -1505,6 +1530,26 @@ routes pipe config = do
       Just tP -> do
         status ok200
         Web.Scotty.json $ toJSON (tP :: LangComponent)
+  where
+    saveOrder :: Pipe -> T.Text -> User -> ZGoOrder -> ActionM ()
+    saveOrder pipe dbName u q = do
+      if uaddress u == qaddress q
+        then do
+          if qtoken q == ""
+            then do
+              t <- liftIO generateToken
+              _ <-
+                liftAndCatchIO $
+                access
+                  pipe
+                  master
+                  dbName
+                  (upsertOrder $ setOrderToken (T.pack t) q)
+              status created201
+            else do
+              _ <- liftAndCatchIO $ access pipe master dbName (upsertOrder q)
+              status created201
+        else status forbidden403
   {-post "/api/setlang" $ do-}
     {-langComp <- jsonData-}
     {-_ <--}

From 1c3dfd2da1e54c16257691a656f91e374dccac17 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Mon, 16 Oct 2023 15:43:26 -0500
Subject: [PATCH 48/57] Remove unused orderx endpoint

---
 CHANGELOG.md      |  1 +
 src/ZGoBackend.hs | 40 ++++++++++++++++++++--------------------
 2 files changed, 21 insertions(+), 20 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index cccc5c4..8b4c957 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -21,6 +21,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 
 ### Removed
 
+- `api/orderx` endpoint.
 - `makeZcashCall` function moved to the generic `zcash-haskell` library.
 - `RpcResponse`, `RpcCall` types moved to the generic `zcash-haskell` library.
 
diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index 7673ea1..cd57477 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -1400,26 +1400,26 @@ routes pipe config = do
                  , "order" .= toJSON (pOrder :: ZGoOrder)
                  ])
   --Upsert xero order
-  post "/api/orderx" $ do
-    newOrder <- jsonData
-    let q = payload (newOrder :: Payload ZGoOrder)
-    _ <- liftIO $ run (upsertXeroOrder q)
-    myOrder <-
-      liftAndCatchIO $
-      run (findXeroOrder (qaddress q) (qexternalInvoice q) (qshortCode q))
-    case myOrder of
-      Nothing -> status noContent204
-      Just o -> do
-        let o' = cast' (Doc o)
-        case o' of
-          Nothing -> status internalServerError500
-          Just pOrder -> do
-            status created201
-            Web.Scotty.json
-              (object
-                 [ "message" .= ("Order found!" :: String)
-                 , "order" .= toJSON (pOrder :: ZGoOrder)
-                 ])
+  {-post "/api/orderx" $ do-}
+    {-newOrder <- jsonData-}
+    {-let q = payload (newOrder :: Payload ZGoOrder)-}
+    {-_ <- liftIO $ run (upsertXeroOrder q)-}
+    {-myOrder <--}
+      {-liftAndCatchIO $-}
+      {-run (findXeroOrder (qaddress q) (qexternalInvoice q) (qshortCode q))-}
+    {-case myOrder of-}
+      {-Nothing -> status noContent204-}
+      {-Just o -> do-}
+        {-let o' = cast' (Doc o)-}
+        {-case o' of-}
+          {-Nothing -> status internalServerError500-}
+          {-Just pOrder -> do-}
+            {-status created201-}
+            {-Web.Scotty.json-}
+              {-(object-}
+                 {-[ "message" .= ("Order found!" :: String)-}
+                 {-, "order" .= toJSON (pOrder :: ZGoOrder)-}
+                 {-])-}
   -- Upsert order
   post "/api/order" $ do
     newOrder <- jsonData

From 7daa9a96876a950b7f519ebe03c31ef5a8fcc0fe Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Thu, 19 Oct 2023 14:47:57 -0500
Subject: [PATCH 49/57] Add tip setting to owners

---
 src/Owner.hs      | 39 ++++++++++++++++++++++++++++++++++-----
 src/ZGoBackend.hs |  1 +
 test/Spec.hs      | 32 +++++++++++++++++++++++++++++++-
 3 files changed, 66 insertions(+), 6 deletions(-)

diff --git a/src/Owner.hs b/src/Owner.hs
index 803fb65..a2e6c1f 100644
--- a/src/Owner.hs
+++ b/src/Owner.hs
@@ -40,10 +40,11 @@ data Owner = Owner
   , 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
@@ -72,6 +73,7 @@ instance ToJSON Owner where
           , "payconf" .= pc
           , "viewkey" .= vk
           , "crmToken" .= cT
+          , "tips" .= oT
           ]
       Nothing ->
         object
@@ -100,6 +102,7 @@ instance ToJSON Owner where
           , "payconf" .= pc
           , "viewkey" .= vk
           , "crmToken" .= cT
+          , "tips" .= oT
           ]
 
 instance FromJSON Owner where
@@ -130,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)
@@ -159,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
@@ -187,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
@@ -213,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
@@ -244,6 +251,7 @@ instance Val Owner where
           , "payconf" =: pc
           , "viewKey" =: vk
           , "crmToken" =: cT
+          , "tips" =: oT
           ]
       Nothing ->
         Doc
@@ -271,6 +279,7 @@ instance Val Owner where
           , "payconf" =: pc
           , "viewKey" =: vk
           , "crmToken" =: cT
+          , "tips" =: oT
           ]
 
 -- | Type to represent informational data for Owners from UI
@@ -320,6 +329,7 @@ data OwnerSettings = OwnerSettings
   , os_payconf :: Bool
   , os_crmToken :: T.Text
   , os_viewKey :: T.Text
+  , os_tips :: Bool
   } deriving (Eq, Show, Generic)
 
 instance FromJSON OwnerSettings where
@@ -340,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
@@ -361,6 +388,7 @@ instance ToJSON OwnerSettings where
       , "payconf" .= pc
       , "crmToken" .= cT
       , "viewkey" .= keyObfuscate vK
+      , "tips" .= oT
       ]
     where
       keyObfuscate s
@@ -386,6 +414,7 @@ getOwnerSettings o =
     (opayconf o)
     (ocrmToken o)
     (oviewkey o)
+    (otips o)
 
 -- Database actions
 -- | Function to upsert an Owner
diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index cd57477..c0f7ce0 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -1201,6 +1201,7 @@ routes pipe config = do
             False
             ""
             ""
+            False
         status accepted202
   post "/api/ownersettings" $ do
     s <- param "session"
diff --git a/test/Spec.hs b/test/Spec.hs
index e1da300..094fb54 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -1248,6 +1248,7 @@ startAPI config = do
           False
           ""
           ""
+          False
   let myOwner1 =
         Owner
           (Just (read "627ad3492b05a76be3000008"))
@@ -1275,6 +1276,7 @@ startAPI config = do
           False
           ""
           ""
+          False
   let myOwner2 =
         Owner
           (Just (read "627ad3492b05a76be3700008"))
@@ -1302,6 +1304,7 @@ startAPI config = do
           False
           ""
           ""
+          False
   let myOwner3 =
         Owner
           (Just (read "627ad3492b05a76be3750008"))
@@ -1329,6 +1332,7 @@ startAPI config = do
           False
           ""
           ""
+          False
   _ <- access pipe master "test" (Database.MongoDB.delete (select [] "owners"))
   let o = val myOwner
   case o of
@@ -1468,7 +1472,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

From bd32d6c149d4db667b94de11956949cb27e22d35 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Fri, 20 Oct 2023 08:09:08 -0500
Subject: [PATCH 50/57] Add tips to database saving action

---
 src/Owner.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/src/Owner.hs b/src/Owner.hs
index a2e6c1f..431b112 100644
--- a/src/Owner.hs
+++ b/src/Owner.hs
@@ -469,6 +469,7 @@ updateOwnerSettings os =
       , "zats" =: os_zats os
       , "payconf" =: os_payconf os
       , "crmToken" =: os_crmToken os
+      , "tips" =: os_tips os
       ]
     ]
 

From 0c77163f31fda61eea1626517b9c6ba014ff454b Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Fri, 20 Oct 2023 13:32:29 -0500
Subject: [PATCH 51/57] Correct order upserting

---
 src/Order.hs | 93 ++++++++++++++++++++++++----------------------------
 1 file changed, 43 insertions(+), 50 deletions(-)

diff --git a/src/Order.hs b/src/Order.hs
index 1aeefdb..bb1bcf6 100644
--- a/src/Order.hs
+++ b/src/Order.hs
@@ -14,24 +14,22 @@ import GHC.Generics
 import Test.QuickCheck
 
 -- | 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
+  } deriving (Eq, Show, Generic)
 
 instance ToJSON ZGoOrder where
   toJSON (ZGoOrder i a s ts c cur p t tZ l paid eI sC tk) =
@@ -74,7 +72,7 @@ instance ToJSON ZGoOrder where
 instance FromJSON ZGoOrder where
   parseJSON =
     withObject "Order" $ \obj -> do
-      i <- obj .: "_id"
+      i <- obj .:? "_id"
       a <- obj .: "address"
       s <- obj .: "session"
       ts <- obj .: "timestamp"
@@ -88,24 +86,7 @@ instance FromJSON ZGoOrder where
       eI <- obj .: "externalInvoice"
       sC <- obj .: "shortCode"
       tk <- obj .: "token"
-      pure $
-        ZGoOrder
-          (if not (null i)
-             then Just (read i)
-             else Nothing)
-          a
-          s
-          ts
-          c
-          cur
-          p
-          t
-          tZ
-          l
-          pd
-          eI
-          sC
-          tk
+      pure $ ZGoOrder (read =<< i) a s ts c cur p t tZ l pd eI sC tk
 
 instance Val ZGoOrder where
   val (ZGoOrder i a s ts c cur p t tZ l pd eI sC tk) =
@@ -160,13 +141,11 @@ instance Val ZGoOrder where
   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]
@@ -193,10 +172,10 @@ upsertOrder :: ZGoOrder -> Action IO ()
 upsertOrder o = do
   let order = val $ updateOrderTotals o
   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
@@ -210,7 +189,14 @@ upsertXeroOrder :: ZGoOrder -> Action IO ()
 upsertXeroOrder o = do
   let order = val $ updateOrderTotals o
   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
@@ -247,13 +233,20 @@ 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")

From 50925970fc40e61b8cf1ca0ac5098ffeff131a8a Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Fri, 20 Oct 2023 14:52:09 -0500
Subject: [PATCH 52/57] Correct order Id handling

---
 src/Order.hs | 22 ++++++++++++++++++++--
 1 file changed, 20 insertions(+), 2 deletions(-)

diff --git a/src/Order.hs b/src/Order.hs
index bb1bcf6..0a43ff9 100644
--- a/src/Order.hs
+++ b/src/Order.hs
@@ -12,6 +12,7 @@ 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
@@ -72,7 +73,7 @@ instance ToJSON ZGoOrder where
 instance FromJSON ZGoOrder where
   parseJSON =
     withObject "Order" $ \obj -> do
-      i <- obj .:? "_id"
+      i <- obj .: "_id"
       a <- obj .: "address"
       s <- obj .: "session"
       ts <- obj .: "timestamp"
@@ -86,7 +87,24 @@ instance FromJSON ZGoOrder where
       eI <- obj .: "externalInvoice"
       sC <- obj .: "shortCode"
       tk <- obj .: "token"
-      pure $ ZGoOrder (read =<< i) a s ts c cur p t tZ l pd eI sC tk
+      pure $
+        ZGoOrder
+          (if not (null i)
+             then Just (read i :: ObjectId)
+             else Nothing)
+          a
+          s
+          ts
+          c
+          cur
+          p
+          t
+          tZ
+          l
+          pd
+          eI
+          sC
+          tk
 
 instance Val ZGoOrder where
   val (ZGoOrder i a s ts c cur p t tZ l pd eI sC tk) =

From 9c44d0443e81198baaa77b157c4675fa53cc04d3 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Fri, 20 Oct 2023 15:32:14 -0500
Subject: [PATCH 53/57] Add tax and tip fields to order

---
 src/Order.hs      | 39 +++++++++++++++++++++++++++++++++------
 src/ZGoBackend.hs |  6 ++++++
 test/Spec.hs      | 20 +++++++++++++++++++-
 3 files changed, 58 insertions(+), 7 deletions(-)

diff --git a/src/Order.hs b/src/Order.hs
index 0a43ff9..4c60669 100644
--- a/src/Order.hs
+++ b/src/Order.hs
@@ -30,10 +30,13 @@ data ZGoOrder = ZGoOrder
   , 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
@@ -51,6 +54,9 @@ instance ToJSON ZGoOrder where
           , "externalInvoice" .= eI
           , "shortCode" .= sC
           , "token" .= tk
+          , "taxAmount" .= qT
+          , "vatAmount" .= qV
+          , "tipAmount" .= tip
           ]
       Nothing ->
         object
@@ -68,6 +74,9 @@ instance ToJSON ZGoOrder where
           , "externalInvoice" .= eI
           , "shortCode" .= sC
           , "token" .= tk
+          , "taxAmount" .= qT
+          , "vatAmount" .= qV
+          , "tipAmount" .= tip
           ]
 
 instance FromJSON ZGoOrder where
@@ -87,6 +96,9 @@ 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)
@@ -105,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
@@ -124,6 +139,9 @@ instance Val ZGoOrder where
              , "externalInvoice" =: eI
              , "shortCode" =: sC
              , "token" =: tk
+             , "taxAmount" =: qT
+             , "vatAmount" =: qV
+             , "tipAmount" =: tip
              ]
       else Doc
              [ "address" =: a
@@ -139,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
@@ -155,7 +176,10 @@ 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
@@ -237,15 +261,18 @@ updateOrderTotals o =
     (qexternalInvoice o)
     (qshortCode o)
     (qtoken o)
+    (qtax o)
+    (qvat o)
+    (qtip o)
   where
     newTotal :: ZGoOrder -> Double
-    newTotal x = foldr tallyItems 0 (qlines x)
+    newTotal x = foldr tallyItems 0 (qlines x) + qtax o + qvat o + qtip o
     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")
diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index c0f7ce0..68c883b 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -761,6 +761,9 @@ routes pipe config = do
                                                              (xr_shortCode
                                                                 invReq)
                                                              (T.pack tk)
+                                                             0
+                                                             0
+                                                             0
                                                      _ <-
                                                        liftAndCatchIO $
                                                        run $
@@ -1040,6 +1043,9 @@ routes pipe config = do
                                    [T.pack sUrl, "-", ordId, "-", orderKey])
                                 ""
                                 (T.pack tk)
+                                0
+                                0
+                                0
                         newId <- liftAndCatchIO $ run (insertWooOrder newOrder)
                         status ok200
                         Web.Scotty.json
diff --git a/test/Spec.hs b/test/Spec.hs
index 094fb54..35d60cf 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -325,6 +325,9 @@ main = do
                     ""
                     ""
                     "testToken4321"
+                    0
+                    0
+                    0
             req <-
               testPostJson "/api/order" $
               A.object ["payload" A..= A.toJSON testOrder]
@@ -352,6 +355,9 @@ main = do
                     ""
                     ""
                     "testToken4321"
+                    0
+                    0
+                    0
             req <-
               testPostJson "/api/order" $
               A.object ["payload" A..= A.toJSON testOrder]
@@ -379,6 +385,9 @@ main = do
                     ""
                     ""
                     "testToken4321"
+                    0
+                    0
+                    0
             req <-
               testPostJson "/api/order" $
               A.object ["payload" A..= A.toJSON testOrder]
@@ -851,6 +860,9 @@ main = do
                     ""
                     ""
                     "testToken1234"
+                    0
+                    0
+                    0
             let ordTest = val myOrder
             case ordTest of
               Doc oT -> access p master "test" (insert_ "orders" oT)
@@ -1368,6 +1380,9 @@ startAPI config = do
           ""
           ""
           "testToken1234"
+          0
+          0
+          0
   let ordTest = val myOrder
   case ordTest of
     Doc oT -> access pipe master "test" (insert_ "orders" oT)
@@ -1433,7 +1448,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

From a20271db6d97dd4c68e99389323cd885e76916bd Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Mon, 23 Oct 2023 13:43:45 -0500
Subject: [PATCH 54/57] Create utility to load updated languages

---
 app/Tasks.hs      |  1 +
 src/ZGoBackend.hs | 11 +++++++++++
 stack.yaml        |  2 +-
 stack.yaml.lock   |  8 ++++----
 zgo-backend.cabal |  2 +-
 5 files changed, 18 insertions(+), 6 deletions(-)

diff --git a/app/Tasks.hs b/app/Tasks.hs
index 62027da..12ffa3a 100644
--- a/app/Tasks.hs
+++ b/app/Tasks.hs
@@ -29,5 +29,6 @@ main = do
       expireOwners pipe (c_dbName loadedConfig)
       updateLogins pipe loadedConfig
       expireProSessions pipe (c_dbName loadedConfig)
+      loadTranslations pipe loadedConfig
       close pipe
     else fail "MongoDB connection failed!"
diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index 68c883b..9f9a9fe 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -15,6 +15,7 @@ import Control.Monad.IO.Class
 import Crypto.RNG (newCryptoRNGState, runCryptoRNGT)
 import Crypto.RNG.Utils (randomString)
 import Data.Aeson
+import Data.Aeson (decodeFileStrict)
 import Data.Array
 import qualified Data.Bson as B
 import qualified Data.ByteArray as BA
@@ -2176,3 +2177,13 @@ upsertBlock b = do
 
 findBlock :: Action IO (Maybe Document)
 findBlock = findOne (select ["network" =: ("mainnet" :: String)] "blocks")
+
+loadTranslations :: Pipe -> Config -> IO ()
+loadTranslations pipe config = do
+  itemList <- decodeFileStrict "zgolanguagedb.json"
+  case itemList of
+    Nothing -> print "Couldn't not parse JSON file"
+    Just langItems ->
+      mapM_
+        (access pipe master (c_dbName config) . loadLangComponent)
+        (langItems :: [LangComponent])
diff --git a/stack.yaml b/stack.yaml
index 90f0c8e..8f78da2 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -17,7 +17,7 @@
 #
 # resolver: ./custom-snapshot.yaml
 # resolver: https://example.com/snapshots/2018-01-01.yaml
-resolver: lts-21.4
+resolver: lts-21.17
   #url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/4.yaml
 
 # User packages to be built.
diff --git a/stack.yaml.lock b/stack.yaml.lock
index 8cc2c00..d88e25b 100644
--- a/stack.yaml.lock
+++ b/stack.yaml.lock
@@ -103,7 +103,7 @@ packages:
     hackage: crypto-rng-0.3.0.1@sha256:04f4ae75943ecad8b794950985054130f272d65a588b6b6528f56df0bfedc4dc,1565
 snapshots:
 - completed:
-    sha256: caa77fdbc5b9f698262b21ee78030133272ec53116ad6ddbefdc4c321f668e0c
-    size: 640014
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/21/4.yaml
-  original: lts-21.4
+    sha256: 85d2382958c178491d3fe50d770a624621f5ab456beef7d31ac7521f780c9bc7
+    size: 640042
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/21/17.yaml
+  original: lts-21.17
diff --git a/zgo-backend.cabal b/zgo-backend.cabal
index 9710f2c..0d59748 100644
--- a/zgo-backend.cabal
+++ b/zgo-backend.cabal
@@ -1,6 +1,6 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.35.1.
+-- This file has been generated from package.yaml by hpack version 0.35.2.
 --
 -- see: https://github.com/sol/hpack
 

From 9bd94843b4637296ae55ea4adf3163aa2dfc88ef Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Wed, 25 Oct 2023 16:16:42 -0500
Subject: [PATCH 55/57] Add tax calculations

---
 src/Order.hs      | 30 ++++++++------
 src/ZGoBackend.hs | 99 ++++++++++++++++++++++++++---------------------
 2 files changed, 73 insertions(+), 56 deletions(-)

diff --git a/src/Order.hs b/src/Order.hs
index 4c60669..1f54a40 100644
--- a/src/Order.hs
+++ b/src/Order.hs
@@ -210,9 +210,9 @@ 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 ->
       if isJust (q_id o)
@@ -222,14 +222,14 @@ upsertOrder o = do
 
 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
@@ -242,8 +242,8 @@ upsertXeroOrder o = do
     _ -> 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)
@@ -252,9 +252,9 @@ 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)
@@ -265,8 +265,13 @@ updateOrderTotals o =
     (qvat o)
     (qtip o)
   where
-    newTotal :: ZGoOrder -> Double
-    newTotal x = foldr tallyItems 0 (qlines x) + qtax o + qvat o + qtip o
+    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
 
@@ -306,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)
diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index 9f9a9fe..da23781 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -768,7 +768,7 @@ routes pipe config = do
                                                      _ <-
                                                        liftAndCatchIO $
                                                        run $
-                                                       upsertOrder newOrder
+                                                       upsertOrder newOrder 0 0
                                                      finalOrder <-
                                                        liftAndCatchIO $
                                                        run $
@@ -1437,27 +1437,22 @@ routes pipe config = do
     case cast' . Doc =<< user of
       Nothing -> status unauthorized401
       Just u -> do
-        dbOrder <-
-          liftAndCatchIO $ run (findOrderById $ maybe "0" show (q_id q))
-        case cast' . Doc =<< dbOrder of
-          Nothing -> do
-            if uaddress u == qaddress q
-              then do
-                if qtoken q == ""
-                  then do
-                    t <- liftIO generateToken
-                    _ <-
-                      liftAndCatchIO $
-                      run (upsertOrder $ setOrderToken (T.pack t) q)
-                    status created201
-                  else do
-                    _ <-
-                      liftAndCatchIO $ access pipe master dbName (upsertOrder q)
-                    status created201
-              else status forbidden403
-          Just dbO -> do
-            if qaddress q == qaddress dbO && qsession q == qsession dbO
-              then do
+        owner <- liftAndCatchIO $ run $ findOwner (uaddress u)
+        case cast' . Doc =<< owner of
+          Nothing -> status badRequest400
+          Just o -> do
+            let taxRate =
+                  if otax o
+                    then otaxValue o
+                    else 0
+            let vatRate =
+                  if ovat o
+                    then ovatValue o
+                    else 0
+            dbOrder <-
+              liftAndCatchIO $ run (findOrderById $ maybe "0" show (q_id q))
+            case cast' . Doc =<< dbOrder of
+              Nothing -> do
                 if uaddress u == qaddress q
                   then do
                     if qtoken q == ""
@@ -1465,15 +1460,49 @@ routes pipe config = do
                         t <- liftIO generateToken
                         _ <-
                           liftAndCatchIO $
-                          run (upsertOrder $ setOrderToken (T.pack t) q)
+                          run
+                            (upsertOrder
+                               (setOrderToken (T.pack t) q)
+                               taxRate
+                               vatRate)
                         status created201
                       else do
                         _ <-
                           liftAndCatchIO $
-                          access pipe master dbName (upsertOrder q)
+                          access
+                            pipe
+                            master
+                            dbName
+                            (upsertOrder q taxRate vatRate)
                         status created201
                   else status forbidden403
-              else status forbidden403
+              Just dbO -> do
+                if qaddress q == qaddress dbO && qsession q == qsession dbO
+                  then do
+                    if uaddress u == qaddress q
+                      then do
+                        if qtoken q == ""
+                          then do
+                            t <- liftIO generateToken
+                            _ <-
+                              liftAndCatchIO $
+                              run
+                                (upsertOrder
+                                   (setOrderToken (T.pack t) q)
+                                   taxRate
+                                   vatRate)
+                            status created201
+                          else do
+                            _ <-
+                              liftAndCatchIO $
+                              access
+                                pipe
+                                master
+                                dbName
+                                (upsertOrder q taxRate vatRate)
+                            status created201
+                      else status forbidden403
+                  else status forbidden403
   --Delete order
   Web.Scotty.delete "/api/order/:id" $ do
     oId <- param "id"
@@ -1538,26 +1567,6 @@ routes pipe config = do
       Just tP -> do
         status ok200
         Web.Scotty.json $ toJSON (tP :: LangComponent)
-  where
-    saveOrder :: Pipe -> T.Text -> User -> ZGoOrder -> ActionM ()
-    saveOrder pipe dbName u q = do
-      if uaddress u == qaddress q
-        then do
-          if qtoken q == ""
-            then do
-              t <- liftIO generateToken
-              _ <-
-                liftAndCatchIO $
-                access
-                  pipe
-                  master
-                  dbName
-                  (upsertOrder $ setOrderToken (T.pack t) q)
-              status created201
-            else do
-              _ <- liftAndCatchIO $ access pipe master dbName (upsertOrder q)
-              status created201
-        else status forbidden403
   {-post "/api/setlang" $ do-}
     {-langComp <- jsonData-}
     {-_ <--}

From b670a1c15fd13b69d401acd272824e1c3cd7442e Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Wed, 25 Oct 2023 16:25:27 -0500
Subject: [PATCH 56/57] Fix tax calculationj

---
 src/Order.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/Order.hs b/src/Order.hs
index 1f54a40..8ea88ca 100644
--- a/src/Order.hs
+++ b/src/Order.hs
@@ -261,8 +261,8 @@ updateOrderTotals o taxRate vatRate =
     (qexternalInvoice o)
     (qshortCode o)
     (qtoken o)
-    (qtax o)
-    (qvat o)
+    (updateTax o taxRate)
+    (updateTax o vatRate)
     (qtip o)
   where
     updateTax :: ZGoOrder -> Double -> Double

From 5d9d261eb95d63bcc522274b6d9b5f0fe78f95dc Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Sat, 28 Oct 2023 07:20:18 -0500
Subject: [PATCH 57/57] Version update

---
 CHANGELOG.md | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 8b4c957..d87c1a2 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -4,7 +4,7 @@ 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.0]
 
 ### Added