From 7dfd18b33a75830b01c94ef9e12cb5b855137d51 Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Tue, 6 Dec 2022 11:04:05 -0600 Subject: [PATCH] Add additional fields for the payment reporting for WooCommerce --- CHANGELOG.md | 3 +- src/WooCommerce.hs | 27 ++++++++++++++++++ src/Xero.hs | 4 +-- src/ZGoBackend.hs | 68 +++++++++++++++++++++++++++++++++++----------- 4 files changed, 83 insertions(+), 19 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index ddbf453..5c2e2a3 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -16,7 +16,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Changed - Refactored code for requesting Xero tokens to make it reusable. -- Change API authentication to allow for endpoints that don't require an `Authorization` header to support the WooCommerce integration +- Changed API authentication to allow for endpoints that don't require an `Authorization` header to support the WooCommerce integration +- Enhanced the on-chain order confirmation functionality to support WooCommerce integration and future integrations. ## [1.1.1] - 2022-10-08 diff --git a/src/WooCommerce.hs b/src/WooCommerce.hs index 566765d..3544c15 100644 --- a/src/WooCommerce.hs +++ b/src/WooCommerce.hs @@ -4,6 +4,7 @@ module WooCommerce where import Data.Aeson import qualified Data.Bson as B +import qualified Data.ByteString as BS import qualified Data.ByteString.Base64 as B64 import qualified Data.ByteString.Char8 as C import Data.Maybe @@ -11,6 +12,8 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as E import Data.Text.Encoding.Error (lenientDecode) import Database.MongoDB +import Network.HTTP.Simple +import Network.HTTP.Types.Status -- | Type to represent the WooCommerce token data WooToken = @@ -47,3 +50,27 @@ findWooToken oid = findOne (select ["owner" =: oid] "wootokens") addUrl :: WooToken -> T.Text -> Action IO () addUrl t u = modify (select ["_id" =: w_id t] "wootokens") ["$set" =: ["url" =: u]] + +payWooOrder :: + String -- url + -> BS.ByteString -- WooCommerce order ID + -> BS.ByteString -- ZGo order id + -> BS.ByteString -- ZGo token + -> BS.ByteString -- Zcash price + -> BS.ByteString -- Total ZEC for order + -> IO () +payWooOrder u i o t p z = do + wooReq <- parseRequest u + let req = + setRequestQueryString + [ ("token", Just t) + , ("orderid", Just o) + , ("wc_orderid", Just i) + , ("rate", Just p) + , ("totalzec", Just z) + ] + wooReq + res <- httpLBS req + if getResponseStatus res == ok200 + then return () + else error "Failed to report payment to WooCommerce" diff --git a/src/Xero.hs b/src/Xero.hs index daa37fd..e98921d 100644 --- a/src/Xero.hs +++ b/src/Xero.hs @@ -438,6 +438,6 @@ payXeroInvoice pipe dbName inv address amt = do setRequestPath "/api.xro/2.0/Payments" $ setRequestHost "api.xero.com" $ setRequestMethod "PUT" defaultRequest - res <- httpJSON req - print (res :: Response Object) + res <- httpJSON req :: IO (Response Object) + return () else error "Invalid parameters" diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs index 1edac81..897e666 100644 --- a/src/ZGoBackend.hs +++ b/src/ZGoBackend.hs @@ -38,7 +38,6 @@ import Debug.Trace import GHC.Generics import Item import Network.HTTP.Simple -import Network.HTTP.Types (created201) import Network.HTTP.Types.Status import Network.Wai (Request, pathInfo) import Network.Wai.Middleware.Cors @@ -715,7 +714,7 @@ routes pipe config = do ZGoOrder Nothing (oaddress o) - ("WC-" <> oname o) + ("WC-" <> (T.pack . show $ o_id o)) (parseTimeOrError True defaultTimeLocale @@ -1109,20 +1108,57 @@ scanPayments config pipe = do case xOrder of Nothing -> error "Failed to retrieve order from database" Just xO -> - unless - (qpaid xO && qexternalInvoice xO == "" && qtotalZec xO == snd x) $ do - xeroConfig <- access p master dbName findXero - let xC = xeroConfig >>= (cast' . Doc) - case xC of - Nothing -> error "Failed to read Xero config" - Just xConf -> do - requestXeroToken p dbName xConf "" (qaddress xO) - payXeroInvoice - p - dbName - (qexternalInvoice xO) - (qaddress xO) - (qtotal xO) + when + (not (qpaid xO) && + qexternalInvoice xO /= "" && qtotalZec xO == snd x) $ do + let sReg = mkRegex "(.*)-([a-fA-f0-9]{24})" + let sResult = matchAllText sReg (T.unpack $ qsession xO) + if not (null sResult) + then case fst $ head sResult ! 1 of + "Xero" -> do + xeroConfig <- access p master dbName findXero + let xC = xeroConfig >>= (cast' . Doc) + case xC of + Nothing -> error "Failed to read Xero config" + Just xConf -> do + requestXeroToken p dbName xConf "" (qaddress xO) + payXeroInvoice + p + dbName + (qexternalInvoice xO) + (qaddress xO) + (qtotal xO) + "WC" -> do + let wOwner = fst $ head sResult ! 2 + wooT <- + access p master dbName $ findWooToken (read wOwner) + let wT = wooT >>= (cast' . Doc) + case wT of + Nothing -> error "Failed to read WooCommerce token" + Just wt -> do + let iReg = mkRegex "(.*)-(.*)" + let iResult = + matchAllText + iReg + (T.unpack $ qexternalInvoice xO) + if not (null iResult) + then do + let wUrl = + E.decodeUtf8With lenientDecode . + B64.decodeLenient . C.pack $ + fst $ head iResult ! 1 + let iNum = fst $ head iResult ! 2 + payWooOrder + (T.unpack wUrl) + (C.pack iNum) + (C.pack . show $ maybe "" show (q_id xO)) + (C.pack . show $ w_owner wt) + (C.pack . show $ qprice xO) + (C.pack . show $ qtotalZec xO) + else error + "Couldn't parse externalInvoice for WooCommerce" + _ -> putStrLn "Not an integration order" + else putStrLn "Not an integration order" -- | RPC methods -- | List addresses with viewing keys loaded