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,55 +1275,42 @@ 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
+              let ownerId = o_id =<< (cast' . Doc) =<< owner
-              case foundOwner of
+              if pdelta pmt > 90000000
-                Nothing -> error "Couldn't find owner to mark as paid"
+                then do
-                Just fOwn -> do
+                  _ <-
-                  if pdelta pmt > 90000000
+                    access
-                    then do
+                      pipe
-                      _ <-
+                      master
-                        access
+                      db
-                          pipe
+                      (modify
-                          master
+                         (select ["_id" =: ownerId] "owners")
-                          db
+                         [ "$set" =:
-                          (modify
+                           [ "paid" =: True
-                             (select ["_id" =: o_id fOwn] "owners")
+                           , "invoices" =: True
-                             [ "$set" =:
+                           , "expiration" =:
-                               [ "paid" =: True
+                             posixSecondsToUTCTime
-                               , "invoices" =: True
+                               (fromInteger
-                               , "expiration" =:
+                                  (pblocktime pmt + pdelta pmt - 90000000))
-                                 calculateExpiration
+                           ]
-                                   fOwn
+                         ])
-                                   (pdelta pmt - 90000000)
+                  markPaymentDone pipe db pmt
-                                   (pblocktime pmt)
+                else do
-                               ]
+                  _ <-
-                             ])
+                    access
-                      markPaymentDone pipe db pmt
+                      pipe
-                    else do
+                      master
-                      _ <-
+                      db
-                        access
+                      (modify
-                          pipe
+                         (select ["_id" =: ownerId] "owners")
-                          master
+                         [ "$set" =:
-                          db
+                           [ "paid" =: True
-                          (modify
+                           , "expiration" =:
-                             (select ["_id" =: o_id fOwn] "owners")
+                             posixSecondsToUTCTime
-                             [ "$set" =:
+                               (fromInteger (pblocktime pmt + pdelta pmt))
-                               [ "paid" =: True
+                           ]
-                               , "expiration" =:
+                         ])
-                                 calculateExpiration
+                  markPaymentDone pipe db pmt
-                                   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

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