From 20061285a2016a6e1188db1ae49a4b6e6d7bf924 Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Fri, 22 Jul 2022 11:04:15 -0500 Subject: [PATCH] Implement marking of orders as paid --- CHANGELOG.md | 2 ++ app/Main.hs | 1 + package.yaml | 1 + src/ZGoBackend.hs | 89 ++++++++++++++++++++++++++++++++++++----------- zgo-backend.cabal | 1 + 5 files changed, 74 insertions(+), 20 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index a4b3830..47819a3 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -8,6 +8,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Added +- New functionality to read transactions for the given viewing keys +- New functionality to mark orders as paid once payment is found on-chain - New `Config` type to house the configuration parameters - New field in `Owner` type to store toggle for payment confirmation - New field in `Owner` type to store viewing key diff --git a/app/Main.hs b/app/Main.hs index fd54e45..76b677f 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -32,6 +32,7 @@ main = do else fail "MongoDB connection failed!" _ <- forkIO (setInterval 60 (checkZcashPrices pipe (c_dbName loadedConfig))) _ <- forkIO (setInterval 75 (scanZcash loadedConfig pipe)) + _ <- forkIO (setInterval 90 (scanPayments loadedConfig pipe)) _ <- forkIO (setInterval 60 (checkPayments pipe (c_dbName loadedConfig))) _ <- forkIO (setInterval 60 (expireOwners pipe (c_dbName loadedConfig))) _ <- forkIO (setInterval 60 (updateLogins pipe loadedConfig)) diff --git a/package.yaml b/package.yaml index 656aacd..6fb13bc 100644 --- a/package.yaml +++ b/package.yaml @@ -50,6 +50,7 @@ library: - warp-tls - hexstring - configurator + - scientific executables: zgo-backend-exe: diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs index 42c1dc2..63a9386 100644 --- a/src/ZGoBackend.hs +++ b/src/ZGoBackend.hs @@ -18,6 +18,7 @@ import Data.Char import qualified Data.HashMap.Strict as HM import Data.HexString import Data.Maybe +import qualified Data.Scientific as Scientific import Data.SecureMem import qualified Data.Text as T import qualified Data.Text.Encoding as E @@ -137,11 +138,19 @@ instance FromJSON ZcashTx where aZ <- obj .: "amountZat" bh <- obj .: "blockheight" bt <- obj .: "blocktime" - c <- obj .: "change" + c <- obj .:? "change" conf <- obj .: "confirmations" m <- obj .: "memo" pure $ - ZcashTx t a aZ bh bt c conf (T.filter (/= '\NUL') $ decodeHexText m) + ZcashTx + t + a + aZ + bh + bt + (fromMaybe False c) + conf + (T.filter (/= '\NUL') $ decodeHexText m) instance ToJSON ZcashTx where toJSON (ZcashTx t a aZ bh bt c conf m) = @@ -315,8 +324,8 @@ zToZGoTx (ZcashTx t a aZ bh bt c conf m) = do if not (null reg) then do let sess = T.pack (fst $ head reg ! 1) - let addy = T.pack (fst $ head reg ! 2) - ZGoTx Nothing addy sess conf bt a t m + let nAddy = T.pack (fst $ head reg ! 2) + ZGoTx Nothing nAddy sess conf bt a t m else do if not (null reg2) then do @@ -711,19 +720,34 @@ checkZcashPrices p db = do q <- getZcashPrices mapM_ (access p master db) (updatePrices (getResponseBody q)) +-- | Function to search for transactions for an address +listTxs :: + BS.ByteString + -> BS.ByteString + -> T.Text + -> Integer + -> IO (Either T.Text [ZcashTx]) +listTxs user pwd a confs = do + res <- + liftIO $ + makeZcashCall + user + pwd + "z_listreceivedbyaddress" + [Data.Aeson.String a, Data.Aeson.Number $ Scientific.scientific confs 0] + let content = getResponseBody res :: RpcResponse [ZcashTx] + case err content of + Nothing -> + return $ Right $ filter (not . zchange) $ fromMaybe [] $ result content + Just e -> return $ Left $ "Error reading transactions: " <> emessage e + -- | Function to check the ZGo full node for new txs scanZcash :: Config -> Pipe -> IO () scanZcash config pipe = do - res <- - makeZcashCall - (c_nodeUser config) - (c_nodePwd config) - "z_listreceivedbyaddress" - [Data.Aeson.String (c_nodeAddress config)] - let content = getResponseBody res :: RpcResponse [ZcashTx] - case err content of - Nothing -> do - let txs = filter (not . zchange) $ fromMaybe [] $ result content + myTxs <- + listTxs (c_nodeUser config) (c_nodePwd config) (c_nodeAddress config) 1 + case myTxs of + Right txs -> do let r = mkRegex ".*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})\\sReply-To:\\s(zs[a-z0-9]{76}).*" @@ -734,14 +758,39 @@ scanZcash config pipe = do 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 - Just e -> do - putStrLn $ "Error scanning node transactions: " ++ T.unpack (emessage e) + Left e -> do + putStrLn $ "Error scanning node transactions: " ++ T.unpack e return () + +-- | Function to filter transactions +isRelevant :: Text.Regex.Regex -> ZcashTx -> Bool +isRelevant re t + | zconfirmations t < 10 && (matchTest re . T.unpack . zmemo) t = True + | otherwise = False + +-- | Function to scan loaded viewing keys for payments +scanPayments :: Config -> Pipe -> IO () +scanPayments config pipe = do + shops <- listAddresses (c_nodeUser config) (c_nodePwd config) + mapM_ (findPaidOrders config pipe) shops where - isRelevant :: Text.Regex.Regex -> ZcashTx -> Bool - isRelevant re t - | zconfirmations t < 10 && (matchTest re . T.unpack . zmemo) t = True - | otherwise = False + findPaidOrders :: Config -> Pipe -> ZcashAddress -> IO () + findPaidOrders c p z = do + paidTxs <- listTxs (c_nodeUser c) (c_nodePwd c) (addy z) 5 + case paidTxs of + Right txs -> do + let r = mkRegex ".*ZGo Order::([0-9a-fA-F]{24}).*" + let k = filter (isRelevant r) txs + let j = map (getOrderId r) k + mapM_ (access p master (c_dbName config) . markOrderPaid) j + Left e -> putStrLn $ T.unpack e + getOrderId :: Text.Regex.Regex -> ZcashTx -> String + getOrderId re t = do + let reg = matchAllText re (T.unpack $ zmemo t) + if not (null reg) + then do + fst $ head reg ! 1 + else "" -- | RPC methods -- | List addresses with viewing keys loaded diff --git a/zgo-backend.cabal b/zgo-backend.cabal index 1d00706..f77af56 100644 --- a/zgo-backend.cabal +++ b/zgo-backend.cabal @@ -54,6 +54,7 @@ library , random , regex-base , regex-compat + , scientific , scotty , securemem , text