Add additional fields for the payment reporting for WooCommerce

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
 

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"

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"

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