From ddb451383bb593264a256382eb010ccc61be6799 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Mon, 30 Jan 2023 15:29:21 -0600
Subject: [PATCH 1/2] Implement payments enhancements and tests

---
 src/ZGoBackend.hs | 85 +++++++++++++++++++++++++++--------------------
 test/Spec.hs      | 31 ++---------------
 zgo-backend.cabal |  2 +-
 3 files changed, 52 insertions(+), 66 deletions(-)

diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index db35406..6242898 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -1275,42 +1275,55 @@ payOwner p d x =
               let parsedUser = parseUserBson =<< user
               let zaddy = maybe "" uaddress parsedUser
               owner <- access pipe master db $ findOwner zaddy
-              let ownerId = o_id =<< (cast' . Doc) =<< owner
-              if pdelta pmt > 90000000
-                then do
-                  _ <-
-                    access
-                      pipe
-                      master
-                      db
-                      (modify
-                         (select ["_id" =: ownerId] "owners")
-                         [ "$set" =:
-                           [ "paid" =: True
-                           , "invoices" =: True
-                           , "expiration" =:
-                             posixSecondsToUTCTime
-                               (fromInteger
-                                  (pblocktime pmt + pdelta pmt - 90000000))
-                           ]
-                         ])
-                  markPaymentDone pipe db pmt
-                else do
-                  _ <-
-                    access
-                      pipe
-                      master
-                      db
-                      (modify
-                         (select ["_id" =: ownerId] "owners")
-                         [ "$set" =:
-                           [ "paid" =: True
-                           , "expiration" =:
-                             posixSecondsToUTCTime
-                               (fromInteger (pblocktime pmt + pdelta pmt))
-                           ]
-                         ])
-                  markPaymentDone pipe db pmt
+              let foundOwner = (cast' . Doc) =<< owner
+              case foundOwner of
+                Nothing -> error "Couldn't find owner to mark as paid"
+                Just fOwn -> do
+                  if pdelta pmt > 90000000
+                    then do
+                      _ <-
+                        access
+                          pipe
+                          master
+                          db
+                          (modify
+                             (select ["_id" =: o_id fOwn] "owners")
+                             [ "$set" =:
+                               [ "paid" =: True
+                               , "invoices" =: True
+                               , "expiration" =:
+                                 calculateExpiration
+                                   fOwn
+                                   (pdelta pmt - 90000000)
+                                   (pblocktime pmt)
+                               ]
+                             ])
+                      markPaymentDone pipe db pmt
+                    else do
+                      _ <-
+                        access
+                          pipe
+                          master
+                          db
+                          (modify
+                             (select ["_id" =: o_id fOwn] "owners")
+                             [ "$set" =:
+                               [ "paid" =: True
+                               , "expiration" =:
+                                 calculateExpiration
+                                   fOwn
+                                   (pdelta pmt)
+                                   (pblocktime pmt)
+                               ]
+                             ])
+                      markPaymentDone pipe db pmt
+            calculateExpiration :: Owner -> Integer -> Integer -> UTCTime
+            calculateExpiration o delta blocktime =
+              if opaid o
+                then addUTCTime
+                       (secondsToNominalDiffTime (fromIntegral delta))
+                       (oexpiration o)
+                else posixSecondsToUTCTime (fromIntegral $ delta + blocktime)
 
 expireOwners :: Pipe -> T.Text -> IO ()
 expireOwners pipe db = do
diff --git a/test/Spec.hs b/test/Spec.hs
index 0d50804..18ad17f 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -454,7 +454,7 @@ main = do
             let s = (cast' . Doc) =<< t
             let payDelta = maybe 0 pdelta s
             payDelta `shouldSatisfy` (> 0)
-          xit "owners are marked as paid" $ \p -> do
+          it "owners are marked as paid" $ \p -> do
             let myUser =
                   User
                     (Just (read "6272a90f2b05a74cf1000002" :: ObjectId))
@@ -697,34 +697,7 @@ startAPI config = do
           True
           False
           False
-          (UTCTime (fromGregorian 2022 4 16) (secondsToDiffTime 0))
-          False
-          ""
-          ""
-  let myOwner1 =
-        Owner
-          (Just (read "627ad3492b05a76be5000001"))
-          "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
-          "Test shop"
-          "usd"
-          False
-          0
-          False
-          0
-          "Bubba"
-          "Gibou"
-          "bubba@zgo.cash"
-          "1 Main St"
-          "Mpls"
-          "Minnesota"
-          "55401"
-          ""
-          "bubbarocks.io"
-          "United States"
-          True
-          False
-          False
-          (UTCTime (fromGregorian 2022 4 16) (secondsToDiffTime 0))
+          (UTCTime (fromGregorian 2023 2 6) (secondsToDiffTime 0))
           False
           ""
           ""
diff --git a/zgo-backend.cabal b/zgo-backend.cabal
index 7c51075..c8efe1f 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.2.2
+version:        1.2.3
 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 f348416b28acdef31a9762a481325e87f27ac2a3 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Mon, 30 Jan 2023 15:31:51 -0600
Subject: [PATCH 2/2] Documentation update

---
 CHANGELOG.md | 6 ++++++
 README.md    | 2 ++
 package.yaml | 2 +-
 3 files changed, 9 insertions(+), 1 deletion(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 8e8d2a6..8fb3b7d 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).
 
+## [1.2.4] - 2023-01-30
+
+### Changed
+
+- Enhance payments to account for early payments on active sessions.
+
 ## [1.2.3] - 2023-01-27
 
 ### Changed
diff --git a/README.md b/README.md
index e03b5d3..e57f8f3 100644
--- a/README.md
+++ b/README.md
@@ -1,5 +1,7 @@
 # ZGo Back End
 
+[![Please don't upload to GitHub](https://nogithub.codeberg.page/badge.svg)](https://nogithub.codeberg.page)
+
 The API server behind the [ZGo.cash](https://zgo.cash) app.
 
 ## Dependencies
diff --git a/package.yaml b/package.yaml
index a612fd6..210a5b0 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name:                zgo-backend
-version:             1.2.3
+version:             1.2.4
 git:                 "https://git.vergara.tech/Vergara_Tech/zgo-backend"
 license:             BOSL
 author:              "Rene Vergara"