CHANGELOG.md

@@ -16,8 +16,7 @@ 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.
-- Changed API authentication to allow for endpoints that don't require an `Authorization` header to support the WooCommerce integration
+- Change 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,7 +4,6 @@ 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
@@ -12,8 +11,6 @@ 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 =
@@ -50,28 +47,3 @@ 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 ++ "/wc-api/zpmtcallback"
-  let req =
-        setRequestQueryString
-          [ ("token", Just t)
-          , ("orderid", Just o)
-          , ("wc_orderid", Just i)
-          , ("rate", Just p)
-          , ("totalzec", Just z)
-          ]
-          wooReq
-  print req
-  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 :: IO (Response Object)
+      res <- httpJSON req
-      return ()
+      print (res :: Response Object)
     else error "Invalid parameters"

src/ZGoBackend.hs

@@ -8,7 +8,6 @@ module ZGoBackend where
 
 import Config
 import Control.Concurrent (forkIO, threadDelay)
-import Control.Exception (try)
 import Control.Monad
 import Control.Monad.IO.Class
 import Data.Aeson
@@ -39,6 +38,7 @@ 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
@@ -619,21 +619,6 @@ routes pipe config = do
     c <- param "code"
     liftAndCatchIO $ run (addAccCode oAdd c)
     status accepted202
-  -- Get the WooCommerce token
-  get "/api/wootoken" $ do
-    oid <- param "ownerid"
-    res <- liftAndCatchIO $ run (findWooToken (read oid))
-    let t1 = cast' . Doc =<< res
-    case t1 of
-      Nothing -> status noContent204
-      Just t -> do
-        status ok200
-        Web.Scotty.json
-          (object
-             [ "ownerid" .= show (w_owner t)
-             , "token" .= w_token t
-             , "siteurl" .= w_url t
-             ])
   -- Authenticate the WooCommerce plugin
   get "/auth" $ do
     oid <- param "ownerid"
@@ -659,26 +644,14 @@ routes pipe config = do
                         , "message" .= ("Authorized!" :: String)
                         ])
                  else do
-                   if (E.decodeUtf8With lenientDecode .
+                   status accepted202
-                       B64.decodeLenient . C.pack . T.unpack)
+                   Web.Scotty.json
-                        siteurl ==
+                     (object
-                      fromMaybe "" (w_url c)
+                        [ "authorized" .= False
-                     then do
+                        , "message" .=
-                       status ok200
+                          ("ZGo shop already linked to" <>
-                       Web.Scotty.json
+                           fromMaybe "" (w_url c))
-                         (object
+                        ])
-                            [ "authorized" .= True
-                            , "message" .= ("Already authorized." :: String)
-                            ])
-                     else do
-                       status accepted202
-                       Web.Scotty.json
-                         (object
-                            [ "authorized" .= False
-                            , "message" .=
-                              ("ZGo shop already linked to " <>
-                               fromMaybe "" (w_url c))
-                            ])
           else do
             status accepted202
             Web.Scotty.json
@@ -694,7 +667,6 @@ routes pipe config = do
     curr <- param "currency"
     amount <- param "amount"
     sUrl <- param "siteurl"
-    orderKey <- param "orderkey"
     res <- liftAndCatchIO $ run (findWooToken (read oid))
     let c = cast' . Doc =<< res
     case c of
@@ -731,9 +703,7 @@ routes pipe config = do
                               ZGoOrder
                                 Nothing
                                 (oaddress o)
-                                (case o_id o of
+                                ("WC-" <> oname o)
-                                   Just o' -> "WC-" <> (T.pack . show $ o')
-                                   Nothing -> "")
                                 (parseTimeOrError
                                    True
                                    defaultTimeLocale
@@ -750,8 +720,7 @@ routes pipe config = do
                                     amount
                                 ]
                                 False
-                                (T.concat
+                                (T.concat [T.pack sUrl, "-", ordId])
-                                   [T.pack sUrl, "-", ordId, "-", orderKey])
                                 ""
                         newId <- liftAndCatchIO $ run (insertWooOrder newOrder)
                         status ok200
@@ -1042,10 +1011,8 @@ getZcashPrices = do
 -- | Function to update the Zcash prices in the ZGo db
 checkZcashPrices :: Pipe -> T.Text -> IO ()
 checkZcashPrices p db = do
-  q <- try getZcashPrices
+  q <- getZcashPrices
-  case q of
+  mapM_ (access p master db) (updatePrices (getResponseBody q))
-    Left e -> print (e :: HttpException)
-    Right q1 -> mapM_ (access p master db) (updatePrices (getResponseBody q1))
 
 -- | Function to search for transactions for an address
 listTxs ::
@@ -1130,57 +1097,20 @@ scanPayments config pipe = do
       case xOrder of
         Nothing -> error "Failed to retrieve order from database"
         Just xO ->
-          when
+          unless
-            (not (qpaid xO) &&
+            (qpaid xO && qexternalInvoice xO == "" && qtotalZec xO == snd x) $ do
-             qexternalInvoice xO /= "" && qtotalZec xO == snd x) $ do
+            xeroConfig <- access p master dbName findXero
-            let sReg = mkRegex "(.*)-([a-fA-f0-9]{24})"
+            let xC = xeroConfig >>= (cast' . Doc)
-            let sResult = matchAllText sReg (T.unpack $ qsession xO)
+            case xC of
-            if not (null sResult)
+              Nothing -> error "Failed to read Xero config"
-              then case fst $ head sResult ! 1 of
+              Just xConf -> do
-                     "Xero" -> do
+                requestXeroToken p dbName xConf "" (qaddress xO)
-                       xeroConfig <- access p master dbName findXero
+                payXeroInvoice
-                       let xC = xeroConfig >>= (cast' . Doc)
+                  p
-                       case xC of
+                  dbName
-                         Nothing -> error "Failed to read Xero config"
+                  (qexternalInvoice xO)
-                         Just xConf -> do
+                  (qaddress xO)
-                           requestXeroToken p dbName xConf "" (qaddress xO)
+                  (qtotal 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 $ maybe "" show (q_id xO))
-                                 (C.pack . T.unpack $ w_token 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

test/Spec.hs

@@ -304,7 +304,6 @@ main = do
                 , ("currency", Just "usd")
                 , ("amount", Just "100.0")
                 , ("date", Just "2022-12-01")
-                , ("orderkey", Just "wc_order_m7qiJ1dNrGDYE")
                 ]
             res <- httpJSON req
             getResponseStatus (res :: Response A.Value) `shouldBe` ok200