Vergara_Tech/zgo-backend
Vergara_Tech
/
zgo-backend
2
1
Fork 0
Code Issues Pull Requests Packages Projects Releases 4 Wiki Activity

Implement payments enhancements and tests

This commit is contained in:
Rene Vergara 2023-01-30 15:29:21 -06:00
parent 9d6d000d27
commit ddb451383b
Signed by: pitmutt
GPG Key ID: 65122AD495A7F5B2
3 changed files with 52 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

85
src/ZGoBackend.hs
View File

@ -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

31
test/Spec.hs
View File

@ -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
""
""

2
zgo-backend.cabal
View File

@ -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