CHANGELOG.md

@@ -4,12 +4,6 @@ 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

README.md

@@ -1,7 +1,5 @@
 # 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

package.yaml

@@ -1,5 +1,5 @@
 name:                zgo-backend
-version:             1.2.4
+version:             1.2.3
 git:                 "https://git.vergara.tech/Vergara_Tech/zgo-backend"
 license:             BOSL
 author:              "Rene Vergara"

src/ZGoBackend.hs

@@ -1275,10 +1275,7 @@ payOwner p d x =
               let parsedUser = parseUserBson =<< user
               let zaddy = maybe "" uaddress parsedUser
               owner <- access pipe master db $ findOwner zaddy
-              let foundOwner = (cast' . Doc) =<< owner
-              case foundOwner of
-                Nothing -> error "Couldn't find owner to mark as paid"
-                Just fOwn -> do
+              let ownerId = o_id =<< (cast' . Doc) =<< owner
               if pdelta pmt > 90000000
                 then do
                   _ <-
@@ -1287,15 +1284,14 @@ payOwner p d x =
                       master
                       db
                       (modify
-                             (select ["_id" =: o_id fOwn] "owners")
+                         (select ["_id" =: ownerId] "owners")
                          [ "$set" =:
                            [ "paid" =: True
                            , "invoices" =: True
                            , "expiration" =:
-                                 calculateExpiration
-                                   fOwn
-                                   (pdelta pmt - 90000000)
-                                   (pblocktime pmt)
+                             posixSecondsToUTCTime
+                               (fromInteger
+                                  (pblocktime pmt + pdelta pmt - 90000000))
                            ]
                          ])
                   markPaymentDone pipe db pmt
@@ -1306,24 +1302,15 @@ payOwner p d x =
                       master
                       db
                       (modify
-                             (select ["_id" =: o_id fOwn] "owners")
+                         (select ["_id" =: ownerId] "owners")
                          [ "$set" =:
                            [ "paid" =: True
                            , "expiration" =:
-                                 calculateExpiration
-                                   fOwn
-                                   (pdelta pmt)
-                                   (pblocktime pmt)
+                             posixSecondsToUTCTime
+                               (fromInteger (pblocktime pmt + pdelta 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

test/Spec.hs

@@ -454,7 +454,7 @@ main = do
             let s = (cast' . Doc) =<< t
             let payDelta = maybe 0 pdelta s
             payDelta `shouldSatisfy` (> 0)
-          it "owners are marked as paid" $ \p -> do
+          xit "owners are marked as paid" $ \p -> do
             let myUser =
                   User
                     (Just (read "6272a90f2b05a74cf1000002" :: ObjectId))
@@ -697,7 +697,34 @@ startAPI config = do
           True
           False
           False
-          (UTCTime (fromGregorian 2023 2 6) (secondsToDiffTime 0))
+          (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))
           False
           ""
           ""

zgo-backend.cabal

@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           zgo-backend
-version:        1.2.3
+version:        1.2.2
 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