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

Fix order endpoint bug

Browse source
This commit is contained in:
Rene Vergara 2022-08-26 17:10:59 -05:00
parent a7a868ac2c
commit 86ba0a1f0f
Signed by: pitmutt
GPG key ID: 65122AD495A7F5B2
3 changed files with 90 additions and 45 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
src/Order.hs
View file

@ -185,7 +185,10 @@ upsertOrder :: ZGoOrder -> Action IO ()
upsertOrder o = do
let order = val $ updateOrderTotals o
case order of
Doc d -> upsert (select ["_id" =: q_id o] "orders") d
Doc d ->
if isJust (q_id o)
then upsert (select ["_id" =: q_id o] "orders") d
else insert_ "orders" d
_ -> return ()
upsertXeroOrder :: ZGoOrder -> Action IO ()

32
src/Payment.hs
View file

@ -66,30 +66,12 @@ instance Val Payment where
, "memo" =: m
]
upsertPayment :: ZGoTx -> Action IO ()
upsertPayment p = do
let delta = sessionCalc $ amount p
let payTx =
Payment
Nothing
delta
False
(address p)
(session p)
(blocktime p)
(amount p)
(txid p)
(memo p)
let payment = val payTx
case payment of
Doc d -> upsert (select ["txid" =: txid p] "payments") d
_ -> return ()
sessionCalc :: Double -> Integer
sessionCalc zec
| zec >= hiPay = 2419200 -- 1 month in seconds
| zec >= medPay = 604800 -- 1 week in seconds
| zec >= lowPay = 86400 -- 1 day in seconds
sessionCalc :: Double -> Double -> Integer
sessionCalc p zec
| p * zec >= 0.95 * proPay = 92419200
| p * zec >= 0.95 * hiPay = 2419200 -- 1 month in seconds
| p * zec >= 0.95 * medPay = 604800 -- 1 week in seconds
| p * zec >= 0.95 * lowPay = 86400 -- 1 day in seconds
| otherwise = 0
where
(lowPay, medPay, hiPay) = (0.005, 0.025, 0.1)
(lowPay, medPay, hiPay, proPay) = (1, 6, 22, 30)

98
src/ZGoBackend.hs
View file

@ -323,8 +323,12 @@ zToZGoTx (ZcashTx t a aZ bh bt c conf m) = do
let p =
mkRegex
".*ZGOp::([0-9a-fA-F]{8}\\b-[0-9a-fA-F]{4}\\b-[0-9a-fA-F]{4}\\b-[0-9a-fA-F]{4}\\b-[0-9a-fA-F]{12}).*"
let y =
mkRegex
".*MSG\\s(zs[a-z0-9]{76}).*ZGO::([0-9a-fA-F]{8}\\b-[0-9a-fA-F]{4}\\b-[0-9a-fA-F]{4}\\b-[0-9a-fA-F]{4}\\b-[0-9a-fA-F]{12}).*"
let reg = matchAllText r (T.unpack m)
let reg2 = matchAllText p (T.unpack m)
let reg3 = matchAllText y (T.unpack m)
if not (null reg)
then do
let sess = T.pack (fst $ head reg ! 1)
@ -335,7 +339,13 @@ zToZGoTx (ZcashTx t a aZ bh bt c conf m) = do
then do
let sess = T.pack (fst $ head reg2 ! 1)
ZGoTx Nothing "" sess conf bt a t m
else ZGoTx Nothing "" "" conf bt a t m
else do
if not (null reg3)
then do
let sess = T.pack (fst $ head reg ! 2)
let nAddy = T.pack (fst $ head reg ! 1)
ZGoTx Nothing nAddy sess conf bt a t m
else ZGoTx Nothing "" "" conf bt a t m
-- |Type to model a price in the ZGo database
data ZGoPrice =
@ -450,6 +460,33 @@ upsertZGoTx :: T.Text -> ZGoTx -> Action IO ()
upsertZGoTx coll t = do
upsert (select ["txid" =: txid t] coll) (encodeZGoTxBson t)
-- | Function to upsert payment
upsertPayment :: Pipe -> T.Text -> ZGoTx -> IO ()
upsertPayment pipe dbName p = do
zecData <- access pipe master dbName (findPrice "usd")
let zecPrice = parseZGoPrice =<< zecData
case zecPrice of
Nothing -> error "Failed to fetch ZEC price"
Just zp -> do
let delta = sessionCalc (price zp) (amount p)
let payTx =
Payment
Nothing
delta
False
(address p)
(session p)
(blocktime p)
(amount p)
(txid p)
(memo p)
let payment = val payTx
case payment of
Doc d ->
access pipe master dbName $
upsert (select ["txid" =: txid p] "payments") d
_ -> return ()
-- | Main API routes
routes :: Pipe -> Config -> ScottyM ()
routes pipe config = do
@ -857,10 +894,15 @@ scanZcash config pipe = do
let p =
mkRegex
".*ZGOp::([0-9a-fA-F]{8}\\b-[0-9a-fA-F]{4}\\b-[0-9a-fA-F]{4}\\b-[0-9a-fA-F]{4}\\b-[0-9a-fA-F]{12}).*"
let y =
mkRegex
".*MSG\\s(zs[a-z0-9]{76}).*ZGO::([0-9a-fA-F]{8}\\b-[0-9a-fA-F]{4}\\b-[0-9a-fA-F]{4}\\b-[0-9a-fA-F]{4}\\b-[0-9a-fA-F]{12}).*"
let k = map zToZGoTx (filter (isRelevant r) txs)
mapM_ (access pipe master (c_dbName config) . upsertZGoTx "txs") k
let j = map zToZGoTx (filter (isRelevant p) txs)
mapM_ (access pipe master (c_dbName config) . upsertPayment) j
mapM_ (upsertPayment pipe (c_dbName config)) j
let l = map zToZGoTx (filter (isRelevant y) txs)
mapM_ (access pipe master (c_dbName config) . upsertZGoTx "txs") l
Left e -> do
putStrLn $ "Error scanning node transactions: " ++ T.unpack e
return ()
@ -964,23 +1006,41 @@ payOwner p d x =
let parsedUser = parseUserBson =<< user
let zaddy = maybe "" uaddress parsedUser
owner <- access pipe master db $ findOwner zaddy
let parsedOwner = (cast' . Doc) =<< owner
let ownerId = o_id =<< parsedOwner
_ <-
access
pipe
master
db
(modify
(select ["_id" =: ownerId] "owners")
[ "$set" =:
[ "paid" =: True
, "expiration" =:
posixSecondsToUTCTime
(fromInteger (pblocktime pmt + pdelta pmt))
]
])
markPaymentDone pipe db pmt
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
, "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
expireOwners :: Pipe -> T.Text -> IO ()
expireOwners pipe db = do