Add check of payment amount
This commit is contained in:
parent
80c6fe6b71
commit
625fdcaee8
2 changed files with 7 additions and 10 deletions
|
@ -210,10 +210,11 @@ findAllOrders a = rest =<< find (select ["address" =: a] "orders")
|
||||||
deleteOrder :: String -> Action IO ()
|
deleteOrder :: String -> Action IO ()
|
||||||
deleteOrder i = deleteOne (select ["_id" =: (read i :: B.ObjectId)] "orders")
|
deleteOrder i = deleteOne (select ["_id" =: (read i :: B.ObjectId)] "orders")
|
||||||
|
|
||||||
markOrderPaid :: String -> Action IO ()
|
markOrderPaid :: (String, Double) -> Action IO ()
|
||||||
markOrderPaid i =
|
markOrderPaid (i, a) = do
|
||||||
|
let
|
||||||
modify
|
modify
|
||||||
(select ["_id" =: (read i :: B.ObjectId)] "orders")
|
(select ["_id" =: (read i :: B.ObjectId), "totalZec" =: a] "orders")
|
||||||
["$set" =: ["paid" =: True]]
|
["$set" =: ["paid" =: True]]
|
||||||
|
|
||||||
-- | Helper function to round to 8 decimal places
|
-- | Helper function to round to 8 decimal places
|
||||||
|
|
|
@ -294,10 +294,6 @@ decodeHexText h = E.decodeUtf8With lenientDecode $ BS.pack $ hexRead h
|
||||||
encodeHexText :: T.Text -> String
|
encodeHexText :: T.Text -> String
|
||||||
encodeHexText t = T.unpack . toText . fromBytes $ E.encodeUtf8 t
|
encodeHexText t = T.unpack . toText . fromBytes $ E.encodeUtf8 t
|
||||||
|
|
||||||
-- | Helper function to round to 8 decimal places
|
|
||||||
roundZec :: Double -> Double
|
|
||||||
roundZec n = fromInteger (round $ n * (10 ^ 8)) / (10.0 ^^ 8)
|
|
||||||
|
|
||||||
-- Types for the ZGo database documents
|
-- Types for the ZGo database documents
|
||||||
-- | Type to model a country for the database's country list
|
-- | Type to model a country for the database's country list
|
||||||
data Country =
|
data Country =
|
||||||
|
@ -788,12 +784,12 @@ scanPayments config pipe = do
|
||||||
let j = map (getOrderId r) k
|
let j = map (getOrderId r) k
|
||||||
mapM_ (access p master (c_dbName config) . markOrderPaid) j
|
mapM_ (access p master (c_dbName config) . markOrderPaid) j
|
||||||
Left e -> putStrLn $ T.unpack e
|
Left e -> putStrLn $ T.unpack e
|
||||||
getOrderId :: Text.Regex.Regex -> ZcashTx -> String
|
getOrderId :: Text.Regex.Regex -> ZcashTx -> (String, Double)
|
||||||
getOrderId re t = do
|
getOrderId re t = do
|
||||||
let reg = matchAllText re (T.unpack $ zmemo t)
|
let reg = matchAllText re (T.unpack $ zmemo t)
|
||||||
if not (null reg)
|
if not (null reg)
|
||||||
then fst $ head reg ! 1
|
then (fst $ head reg ! 1, zamount t)
|
||||||
else ""
|
else ("", 0)
|
||||||
|
|
||||||
-- | RPC methods
|
-- | RPC methods
|
||||||
-- | List addresses with viewing keys loaded
|
-- | List addresses with viewing keys loaded
|
||||||
|
|
Loading…
Reference in a new issue