From ddb451383bb593264a256382eb010ccc61be6799 Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Mon, 30 Jan 2023 15:29:21 -0600 Subject: [PATCH] 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 category: Web