From 0eae258dee49f745f5b8a6d2939eadf3efbe18aa Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Wed, 26 Oct 2022 15:34:29 -0500
Subject: [PATCH 01/16] Implement token refresh utility

---
 CHANGELOG.md               |  8 +++++
 app/{Main.hs => Server.hs} |  2 +-
 app/TokenRefresh.hs        | 35 ++++++++++++++++++++
 package.yaml               | 68 +++++++++++++++++++++++++++-----------
 src/Xero.hs                | 23 +++++++++----
 zgo-backend.cabal          | 33 ++++++++++++++++--
 6 files changed, 138 insertions(+), 31 deletions(-)
 rename app/{Main.hs => Server.hs} (98%)
 create mode 100644 app/TokenRefresh.hs

diff --git a/CHANGELOG.md b/CHANGELOG.md
index c91ec3c..03e38c8 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -6,6 +6,14 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 
 ## [Unreleased]
 
+### Added
+
+- New utility to refresh Xero tokens periodically.
+
+### Changed
+
+- Refactored code for requesting Xero tokens to make it reusable.
+
 ## [1.1.1] - 2022-10-08
 
 ### Changed
diff --git a/app/Main.hs b/app/Server.hs
similarity index 98%
rename from app/Main.hs
rename to app/Server.hs
index 76b677f..5c6ee4f 100644
--- a/app/Main.hs
+++ b/app/Server.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module Main where
+module Server where
 
 import Config
 import Control.Concurrent (forkIO)
diff --git a/app/TokenRefresh.hs b/app/TokenRefresh.hs
new file mode 100644
index 0000000..81b5168
--- /dev/null
+++ b/app/TokenRefresh.hs
@@ -0,0 +1,35 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module TokenRefresh where
+
+import Config
+import Data.Time.Clock
+import Database.MongoDB
+import Xero
+
+main :: IO ()
+main = do
+  putStrLn "Reading config..."
+  now <- getCurrentTime
+  loadedConfig <- loadZGoConfig "zgo.cfg"
+  pipe <- connect $ host (c_dbHost loadedConfig)
+  let db = c_dbName loadedConfig
+  j <-
+    access
+      pipe
+      master
+      db
+      (auth (c_dbUser loadedConfig) (c_dbPassword loadedConfig))
+  if j
+    then putStrLn "Connected to MongoDB!"
+    else fail "MongoDB connection failed!"
+  credsData <- access pipe master db findXero
+  let creds = cast' . Doc =<< credsData
+  tokens <- access pipe master db (findExpiringTokens now)
+  if not (null tokens)
+    then do
+      let t = map (cast' . Doc) tokens
+      case creds of
+        Just c -> mapM_ (refreshToken pipe db c "") t
+        Nothing -> fail "No credentials"
+    else putStrLn "No tokens to refresh1"
diff --git a/package.yaml b/package.yaml
index dad45bd..8a9115b 100644
--- a/package.yaml
+++ b/package.yaml
@@ -56,29 +56,57 @@ library:
 
 executables:
   zgo-backend-exe:
-    main:                Main.hs
+    main:                Server.hs
     source-dirs:         app
     ghc-options:
-    - -threaded
-    - -rtsopts
-    - -with-rtsopts=-N
-    - -Wall
+            - -main-is Server
+            - -threaded
+            - -rtsopts
+            - -with-rtsopts=-N
+            - -Wall
     dependencies:
-    - zgo-backend
-    - base
-    - scotty
-    - wai-extra
-    - securemem
-    - text
-    - aeson
-    - mongoDB
-    - http-types
-    - http-conduit
-    - time
-    - bytestring
-    - configurator
-    - warp-tls
-    - warp
+            - zgo-backend
+            - base
+            - scotty
+            - wai-extra
+            - securemem
+            - text
+            - aeson
+            - mongoDB
+            - http-types
+            - http-conduit
+            - time
+            - bytestring
+            - configurator
+            - warp-tls
+            - warp
+  zgo-token-refresh:
+    main:                TokenRefresh.hs
+    source-dirs:         app
+    ghc-options:
+            - -main-is TokenRefresh
+            - -threaded
+            - -rtsopts
+            - -with-rtsopts=-N
+            - -Wall
+    dependencies:
+            - base
+            - zgo-backend
+            - base
+            - scotty
+            - wai-extra
+            - securemem
+            - text
+            - aeson
+            - mongoDB
+            - http-types
+            - http-conduit
+            - time
+            - bytestring
+            - configurator
+            - warp-tls
+            - warp
+
 
 tests:
   zgo-backend-test:
diff --git a/src/Xero.hs b/src/Xero.hs
index 8d67b4f..daa37fd 100644
--- a/src/Xero.hs
+++ b/src/Xero.hs
@@ -280,17 +280,24 @@ upsertToken t = do
 findToken :: T.Text -> Action IO (Maybe Document)
 findToken a = findOne (select ["address" =: a] "xerotokens")
 
+findExpiringTokens :: UTCTime -> Action IO [Document]
+findExpiringTokens now =
+  rest =<<
+  find
+    (select ["refExpires" =: ["$lte" =: addUTCTime 1728000 now]] "xerotokens")
+
 -- | Function to request accesstoken
 requestXeroToken :: Pipe -> T.Text -> Xero -> T.Text -> T.Text -> IO Bool
 requestXeroToken pipe dbName cred code address = do
   token <- access pipe master dbName $ findToken address
+  let oToken = token >>= cast' . Doc
+  refreshToken pipe dbName cred code oToken
+
+refreshToken :: Pipe -> T.Text -> Xero -> T.Text -> Maybe XeroToken -> IO Bool
+refreshToken pipe dbName cred code token = do
   let pars =
         case token of
-          Just xT -> do
-            let xToken = cast' (Doc xT) :: Maybe XeroToken
-            case xToken of
-              Nothing -> error "Failed to parse XeroToken BSON"
-              Just x -> "grant_type=refresh_token&refresh_token=" <> t_refresh x
+          Just x -> "grant_type=refresh_token&refresh_token=" <> t_refresh x
           Nothing ->
             "grant_type=authorization_code&code=" <>
             code <> "&redirect_uri=http://localhost:4200/xeroauth"
@@ -309,8 +316,10 @@ requestXeroToken pipe dbName cred code address = do
   case rCode of
     200 -> do
       let newToken = getResponseBody (res :: Response XeroToken)
-      let accCode = t_code <$> (token >>= cast' . Doc)
-      pToken <- processToken newToken address (fromMaybe "" accCode)
+      let accCode = t_code <$> token
+      let address = t_address <$> token
+      pToken <-
+        processToken newToken (fromMaybe "" address) (fromMaybe "" accCode)
       --print pToken
       _ <- access pipe master dbName $ upsertToken pToken
       _ <- getTenantId pipe dbName pToken
diff --git a/zgo-backend.cabal b/zgo-backend.cabal
index 4e33148..72bedc9 100644
--- a/zgo-backend.cabal
+++ b/zgo-backend.cabal
@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           zgo-backend
-version:        1.1.0
+version:        1.1.1
 synopsis:       Haskell Back-end for the ZGo point-of-sale application
 description:    Please see the README on GitLab at <https://gitlab.com/pitmutt/zgo-backend#readme>
 category:       Web
@@ -70,12 +70,39 @@ library
   default-language: Haskell2010
 
 executable zgo-backend-exe
-  main-is: Main.hs
+  main-is: Server.hs
   other-modules:
+      TokenRefresh
       Paths_zgo_backend
   hs-source-dirs:
       app
-  ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall
+  ghc-options: -main-is Server -threaded -rtsopts -with-rtsopts=-N -Wall
+  build-depends:
+      aeson
+    , base
+    , bytestring
+    , configurator
+    , http-conduit
+    , http-types
+    , mongoDB
+    , scotty
+    , securemem
+    , text
+    , time
+    , wai-extra
+    , warp
+    , warp-tls
+    , zgo-backend
+  default-language: Haskell2010
+
+executable zgo-token-refresh
+  main-is: TokenRefresh.hs
+  other-modules:
+      Server
+      Paths_zgo_backend
+  hs-source-dirs:
+      app
+  ghc-options: -main-is TokenRefresh -threaded -rtsopts -with-rtsopts=-N -Wall
   build-depends:
       aeson
     , base

From daa4f59faa3bd64e4c011b4a5542a0f443f8e8c8 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Mon, 14 Nov 2022 15:56:30 -0600
Subject: [PATCH 02/16] Implement WooCommerce authentication

---
 CHANGELOG.md       |  2 ++
 src/WooCommerce.hs | 40 +++++++++++++++++++++++++++++
 src/ZGoBackend.hs  | 41 ++++++++++++++++++++++++++++++
 test/Spec.hs       | 63 ++++++++++++++++++++++++++++++++++++++++++++--
 zgo-backend.cabal  |  1 +
 5 files changed, 145 insertions(+), 2 deletions(-)
 create mode 100644 src/WooCommerce.hs

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 03e38c8..2d73928 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -9,6 +9,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 ### Added
 
 - New utility to refresh Xero tokens periodically.
+- New module for WooCommerce interaction.
+- New `/api/auth` endpoint to authenticate with the WooCommerce plugin
 
 ### Changed
 
diff --git a/src/WooCommerce.hs b/src/WooCommerce.hs
new file mode 100644
index 0000000..18eab33
--- /dev/null
+++ b/src/WooCommerce.hs
@@ -0,0 +1,40 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module WooCommerce where
+
+import Data.Aeson
+import qualified Data.Bson as B
+import Data.Maybe
+import qualified Data.Text as T
+import Database.MongoDB
+
+-- | Type to represent the WooCommerce token
+data WooToken =
+  WooToken
+    { w_id :: Maybe ObjectId
+    , w_owner :: ObjectId
+    , w_token :: T.Text
+    , w_url :: Maybe T.Text
+    }
+  deriving (Eq, Show)
+
+instance Val WooToken where
+  val (WooToken i o t u) =
+    if isJust i
+      then Doc ["_id" =: i, "owner" =: o, "token" =: t, "url" =: u]
+      else Doc ["owner" =: o, "token" =: t, "url" =: u]
+  cast' (Doc d) = do
+    i <- B.lookup "_id" d
+    o <- B.lookup "owner" d
+    t <- B.lookup "token" d
+    u <- B.lookup "url" d
+    Just (WooToken i o t u)
+  cast' _ = Nothing
+
+-- Database actions
+findWooToken :: ObjectId -> Action IO (Maybe Document)
+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]]
diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index 3c55d77..d3ad484 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -52,6 +52,7 @@ import Text.Regex
 import Text.Regex.Base
 import User
 import Web.Scotty
+import WooCommerce
 import Xero
 import ZGoTx
 
@@ -604,6 +605,46 @@ routes pipe config = do
     c <- param "code"
     liftAndCatchIO $ run (addAccCode oAdd c)
     status accepted202
+  -- Authenticate the WooCommerce plugin
+  get "/api/auth" $ do
+    oid <- param "ownerid"
+    t <- param "token"
+    siteurl <- param "siteurl"
+    res <- liftAndCatchIO $ run (findWooToken (read oid))
+    let c = cast' . Doc =<< res
+    case c of
+      Nothing -> do
+        status accepted202
+        Web.Scotty.json
+          (object
+             ["authorized" .= False, "message" .= ("Owner not found" :: String)])
+      Just c ->
+        if t == w_token c
+          then if isNothing (w_url c)
+                 then do
+                   liftAndCatchIO $ run (addUrl c siteurl)
+                   status ok200
+                   Web.Scotty.json
+                     (object
+                        [ "authorized" .= True
+                        , "message" .= ("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
+              (object
+                 [ "authorized" .= False
+                 , "message" .= ("Token mismatch" :: String)
+                 ])
   --Get user associated with session
   get "/api/user" $ do
     sess <- param "session"
diff --git a/test/Spec.hs b/test/Spec.hs
index f106b87..15d5aa5 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -33,6 +33,7 @@ import Test.QuickCheck.Gen
 import Test.QuickCheck.Monadic
 import User
 import Web.Scotty
+import WooCommerce
 import Xero
 import ZGoBackend
 import ZGoTx
@@ -156,7 +157,7 @@ main = do
             res <- httpJSON req
             getResponseStatus (res :: Response A.Value) `shouldBe` ok200
         describe "blockheight endpoint" $ do
-          xit "returns a block number" $ do
+          it "returns a block number" $ do
             req <- testGet "/api/blockheight" []
             res <- httpJSON req
             height (getResponseBody (res :: Response Block)) `shouldSatisfy` \x ->
@@ -250,6 +251,48 @@ main = do
             req <- testDelete "/api/item/" "627d7ba92b05a76be3000003"
             res <- httpLBS req
             getResponseStatus res `shouldBe` ok200
+        describe "WooCommerce endpoints" $ do
+          it "generate token" pending
+          it "authenticate with incorrect owner" $ do
+            req <-
+              testGet
+                "/api/auth/"
+                [ ("ownerid", Just "62cca13f5530331e2a900001")
+                , ("token", Just "89bd9d8d69a674e0f467cc8796ed151a")
+                , ("siteurl", Just "testyMcTest")
+                ]
+            res <- httpJSON req
+            getResponseStatus (res :: Response A.Value) `shouldBe` accepted202
+          it "authenticate with incorrect token" $ do
+            req <-
+              testGet
+                "/api/auth/"
+                [ ("ownerid", Just "62cca13f5530331e2a97c78e")
+                , ("token", Just "89bd9d8d69a674e0f467cc8796000000")
+                , ("siteurl", Just "testyMcTest")
+                ]
+            res <- httpJSON req
+            getResponseStatus (res :: Response A.Value) `shouldBe` accepted202
+          it "authenticate with correct token" $ do
+            req <-
+              testGet
+                "/api/auth/"
+                [ ("ownerid", Just "62cca13f5530331e2a97c78e")
+                , ("token", Just "89bd9d8d69a674e0f467cc8796ed151a")
+                , ("siteurl", Just "testyMcTest")
+                ]
+            res <- httpJSON req
+            getResponseStatus (res :: Response A.Value) `shouldBe` ok200
+          it "authenticate with correct token on existing shop" $ do
+            req <-
+              testGet
+                "/api/auth/"
+                [ ("ownerid", Just "62cca13f5530331e2a97c78e")
+                , ("token", Just "89bd9d8d69a674e0f467cc8796ed151a")
+                , ("siteurl", Just "testyMcTest")
+                ]
+            res <- httpJSON req
+            getResponseStatus (res :: Response A.Value) `shouldBe` accepted202
     around handleDb $
       describe "Database actions" $ do
         describe "authentication" $ do
@@ -304,7 +347,7 @@ main = do
           it "deleted" $ \p -> do
             t <- access p master "test" $ findOne (select [] "users")
             let s = parseUserBson =<< t
-            let userId = maybe Nothing u_id s
+            let userId = u_id =<< s
             let idString = maybe "" show userId
             _ <- access p master "test" $ deleteUser idString
             q <-
@@ -332,6 +375,7 @@ main = do
             let ordTest = val myOrder
             case ordTest of
               Doc oT -> access p master "test" (insert_ "orders" oT)
+              _ -> fail "Couldn't save Order in DB"
             _ <-
               access p master "test" $
               markOrderPaid ("627ab3ea2b05a76be3000001", 0)
@@ -576,6 +620,8 @@ startAPI config = do
   c <- access pipe master "zgo" (auth "zgo" "zcashrules")
   let appRoutes = routes pipe config
   _ <- forkIO (scotty 3000 appRoutes)
+  _ <-
+    access pipe master "test" (Database.MongoDB.delete (select [] "wootokens"))
   let myUser =
         User
           (Just (read "6272a90f2b05a74cf1000001" :: ObjectId))
@@ -629,6 +675,7 @@ startAPI config = do
   let o = val myOwner
   case o of
     Doc d -> access pipe master "test" (insert_ "owners" d)
+    _ -> fail "Couldn't save Owner in DB"
   _ <- access pipe master "test" (Database.MongoDB.delete (select [] "orders"))
   myTs <- liftIO getCurrentTime
   let myOrder =
@@ -649,6 +696,7 @@ startAPI config = do
   let ordTest = val myOrder
   case ordTest of
     Doc oT -> access pipe master "test" (insert_ "orders" oT)
+    _ -> fail "Couldn't save Order in DB"
   let myItem1 =
         Item
           (Just (read "627d7ba92b05a76be3000003"))
@@ -659,6 +707,17 @@ startAPI config = do
   let itemTest = val myItem1
   case itemTest of
     Doc iT -> access pipe master "test" (insert_ "items" iT)
+    _ -> fail "Couldn't save test Item in DB"
+  let myWooToken =
+        WooToken
+          Nothing
+          (read "62cca13f5530331e2a97c78e")
+          "89bd9d8d69a674e0f467cc8796ed151a"
+          Nothing
+  let wooTest = val myWooToken
+  case wooTest of
+    Doc wT -> access pipe master "test" (insert_ "wootokens" wT)
+    _ -> fail "Couldn't save test WooToken in DB"
   threadDelay 1000000
   putStrLn "Test server is up!"
 
diff --git a/zgo-backend.cabal b/zgo-backend.cabal
index 72bedc9..7eb6053 100644
--- a/zgo-backend.cabal
+++ b/zgo-backend.cabal
@@ -32,6 +32,7 @@ library
       Owner
       Payment
       User
+      WooCommerce
       Xero
       ZGoBackend
       ZGoTx

From ebb87feee6c42a10a41ec3a8a7f6d26713436dbf Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Mon, 28 Nov 2022 18:35:06 -0600
Subject: [PATCH 03/16] Implement base64 decode of siteurl

---
 package.yaml       |  1 +
 src/WooCommerce.hs | 11 ++++++++++-
 test/Spec.hs       |  8 ++++----
 zgo-backend.cabal  |  1 +
 4 files changed, 16 insertions(+), 5 deletions(-)

diff --git a/package.yaml b/package.yaml
index 8a9115b..60ffd59 100644
--- a/package.yaml
+++ b/package.yaml
@@ -53,6 +53,7 @@ library:
   - scientific
   - jwt
   - containers
+  - base64-bytestring
 
 executables:
   zgo-backend-exe:
diff --git a/src/WooCommerce.hs b/src/WooCommerce.hs
index 18eab33..566765d 100644
--- a/src/WooCommerce.hs
+++ b/src/WooCommerce.hs
@@ -4,8 +4,12 @@ module WooCommerce where
 
 import Data.Aeson
 import qualified Data.Bson as B
+import qualified Data.ByteString.Base64 as B64
+import qualified Data.ByteString.Char8 as C
 import Data.Maybe
 import qualified Data.Text as T
+import qualified Data.Text.Encoding as E
+import Data.Text.Encoding.Error (lenientDecode)
 import Database.MongoDB
 
 -- | Type to represent the WooCommerce token
@@ -28,7 +32,12 @@ instance Val WooToken where
     o <- B.lookup "owner" d
     t <- B.lookup "token" d
     u <- B.lookup "url" d
-    Just (WooToken i o t u)
+    Just
+      (WooToken
+         i
+         o
+         t
+         (E.decodeUtf8With lenientDecode . B64.decodeLenient . C.pack <$> u))
   cast' _ = Nothing
 
 -- Database actions
diff --git a/test/Spec.hs b/test/Spec.hs
index 15d5aa5..e87364d 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -259,7 +259,7 @@ main = do
                 "/api/auth/"
                 [ ("ownerid", Just "62cca13f5530331e2a900001")
                 , ("token", Just "89bd9d8d69a674e0f467cc8796ed151a")
-                , ("siteurl", Just "testyMcTest")
+                , ("siteurl", Just "aHR0cHM6Ly93d3cudGVjcHJvdmFsLmNvbS8")
                 ]
             res <- httpJSON req
             getResponseStatus (res :: Response A.Value) `shouldBe` accepted202
@@ -269,7 +269,7 @@ main = do
                 "/api/auth/"
                 [ ("ownerid", Just "62cca13f5530331e2a97c78e")
                 , ("token", Just "89bd9d8d69a674e0f467cc8796000000")
-                , ("siteurl", Just "testyMcTest")
+                , ("siteurl", Just "aHR0cHM6Ly93d3cudGVjcHJvdmFsLmNvbS8")
                 ]
             res <- httpJSON req
             getResponseStatus (res :: Response A.Value) `shouldBe` accepted202
@@ -279,7 +279,7 @@ main = do
                 "/api/auth/"
                 [ ("ownerid", Just "62cca13f5530331e2a97c78e")
                 , ("token", Just "89bd9d8d69a674e0f467cc8796ed151a")
-                , ("siteurl", Just "testyMcTest")
+                , ("siteurl", Just "aHR0cHM6Ly93d3cudGVjcHJvdmFsLmNvbS8")
                 ]
             res <- httpJSON req
             getResponseStatus (res :: Response A.Value) `shouldBe` ok200
@@ -289,7 +289,7 @@ main = do
                 "/api/auth/"
                 [ ("ownerid", Just "62cca13f5530331e2a97c78e")
                 , ("token", Just "89bd9d8d69a674e0f467cc8796ed151a")
-                , ("siteurl", Just "testyMcTest")
+                , ("siteurl", Just "aHR0cHM6Ly93d3cuZ29vZ2xlLmNvbS8")
                 ]
             res <- httpJSON req
             getResponseStatus (res :: Response A.Value) `shouldBe` accepted202
diff --git a/zgo-backend.cabal b/zgo-backend.cabal
index 7eb6053..a57aaf1 100644
--- a/zgo-backend.cabal
+++ b/zgo-backend.cabal
@@ -45,6 +45,7 @@ library
     , aeson
     , array
     , base >=4.7 && <5
+    , base64-bytestring
     , bson
     , bytestring
     , configurator

From 3683567b8106e604f21fb045d603f0ed673effc6 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Thu, 1 Dec 2022 14:36:06 -0600
Subject: [PATCH 04/16] Implement WooCommerce order creation

---
 CHANGELOG.md      |  4 +-
 package.yaml      |  1 +
 src/Order.hs      |  7 ++++
 src/ZGoBackend.hs | 97 +++++++++++++++++++++++++++++++++++++++++++++--
 stack.yaml        |  4 +-
 stack.yaml.lock   | 19 +++++-----
 test/Spec.hs      | 49 +++++++++++++++++-------
 zgo-backend.cabal |  3 +-
 8 files changed, 153 insertions(+), 31 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 2d73928..ddbf453 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -10,11 +10,13 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 
 - New utility to refresh Xero tokens periodically.
 - New module for WooCommerce interaction.
-- New `/api/auth` endpoint to authenticate with the WooCommerce plugin
+- New `/auth` endpoint to authenticate with the WooCommerce plugin and corresponding tests
+- New `/woopayment` endpoint to generate a new order from the WooCommerce plugin and corresponding tests
 
 ### 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
 
 ## [1.1.1] - 2022-10-08
 
diff --git a/package.yaml b/package.yaml
index 60ffd59..c996c29 100644
--- a/package.yaml
+++ b/package.yaml
@@ -54,6 +54,7 @@ library:
   - jwt
   - containers
   - base64-bytestring
+  - wai
 
 executables:
   zgo-backend-exe:
diff --git a/src/Order.hs b/src/Order.hs
index d04b97c..b62d6ef 100644
--- a/src/Order.hs
+++ b/src/Order.hs
@@ -191,6 +191,13 @@ upsertOrder o = do
          else insert_ "orders" d
     _ -> return ()
 
+insertWooOrder :: ZGoOrder -> Action IO Database.MongoDB.Value
+insertWooOrder o = do
+  let order = val $ updateOrderTotals o
+  case order of
+    Doc d -> insert "orders" d
+    _ -> fail "Couldn't parse order"
+
 upsertXeroOrder :: ZGoOrder -> Action IO ()
 upsertXeroOrder o = do
   let order = val $ updateOrderTotals o
diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index d3ad484..0521464 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -14,6 +14,8 @@ import Data.Aeson
 import Data.Array
 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.Char
 import qualified Data.HashMap.Strict as HM
 import Data.HexString
@@ -26,6 +28,7 @@ import Data.Text.Encoding.Error (lenientDecode)
 import qualified Data.Text.Lazy as L
 import Data.Time.Clock
 import Data.Time.Clock.POSIX
+import Data.Time.Format
 import Data.Typeable
 import qualified Data.Vector as V
 import Data.Vector.Internal.Check (doChecks)
@@ -37,6 +40,7 @@ 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
 import Network.Wai.Middleware.HttpAuth
 import Numeric
@@ -488,6 +492,16 @@ upsertPayment pipe dbName p = do
           upsert (select ["txid" =: txid p] "payments") d
         _ -> return ()
 
+authSettings :: AuthSettings
+authSettings = "ZGo Backend" {authIsProtected = needsAuth}
+
+needsAuth :: Network.Wai.Request -> IO Bool
+needsAuth req =
+  return $
+  case pathInfo req of
+    "api":_ -> True
+    _ -> False
+
 -- | Main API routes
 routes :: Pipe -> Config -> ScottyM ()
 routes pipe config = do
@@ -508,7 +522,7 @@ routes pipe config = do
   middleware $
     basicAuth
       (\u p -> return $ u == "user" && secureMemFromByteString p == passkey)
-      "ZGo Backend"
+      authSettings
   --Get list of countries for UI
   get "/api/countries" $ do
     countries <- liftAndCatchIO $ run listCountries
@@ -606,13 +620,13 @@ routes pipe config = do
     liftAndCatchIO $ run (addAccCode oAdd c)
     status accepted202
   -- Authenticate the WooCommerce plugin
-  get "/api/auth" $ do
+  get "/auth" $ do
     oid <- param "ownerid"
     t <- param "token"
     siteurl <- param "siteurl"
     res <- liftAndCatchIO $ run (findWooToken (read oid))
-    let c = cast' . Doc =<< res
-    case c of
+    let c1 = cast' . Doc =<< res
+    case c1 of
       Nothing -> do
         status accepted202
         Web.Scotty.json
@@ -645,6 +659,81 @@ routes pipe config = do
                  [ "authorized" .= False
                  , "message" .= ("Token mismatch" :: String)
                  ])
+  get "/woopayment" $ do
+    oid <- param "ownerid"
+    t <- param "token"
+    ordId <- param "order_id"
+    date <- param "date"
+    curr <- param "currency"
+    amount <- param "amount"
+    sUrl <- param "siteurl"
+    res <- liftAndCatchIO $ run (findWooToken (read oid))
+    let c = cast' . Doc =<< res
+    case c of
+      Nothing -> do
+        status accepted202
+        Web.Scotty.json
+          (object ["message" .= ("Plugin not setup in ZGo" :: String)])
+      Just x ->
+        if t == w_token x &&
+           (E.decodeUtf8With lenientDecode . B64.decodeLenient . C.pack) sUrl ==
+           fromMaybe "" (w_url x)
+          then do
+            zecPriceDb <- liftAndCatchIO (run (findPrice curr))
+            let zecPrice = parseZGoPrice =<< zecPriceDb
+            case zecPrice of
+              Nothing -> do
+                status accepted202
+                Web.Scotty.json
+                  (object ["message" .= ("Currency not supported" :: String)])
+              Just zP -> do
+                ownerDb <-
+                  liftAndCatchIO $
+                  run (findOwnerById (T.pack . show $ w_owner x))
+                let owner = cast' . Doc =<< ownerDb
+                case owner of
+                  Nothing -> do
+                    status accepted202
+                    Web.Scotty.json
+                      (object ["message" .= ("Owner not found" :: String)])
+                  Just o ->
+                    if opaid o
+                      then do
+                        let newOrder =
+                              ZGoOrder
+                                Nothing
+                                (oaddress o)
+                                ("WC-" <> oname o)
+                                (parseTimeOrError
+                                   True
+                                   defaultTimeLocale
+                                   "%Y-%0m-%0d"
+                                   date)
+                                True
+                                (T.pack curr)
+                                (price zP)
+                                0.0
+                                0.0
+                                [ LineItem
+                                    1.0
+                                    (oname o <> " order " <> ordId)
+                                    amount
+                                ]
+                                False
+                                (T.concat [T.pack sUrl, "-", ordId])
+                                ""
+                        newId <- liftAndCatchIO $ run (insertWooOrder newOrder)
+                        status ok200
+                        Web.Scotty.json (object ["order" .= show newId])
+                      else do
+                        status accepted202
+                        Web.Scotty.json
+                          (object
+                             ["message" .= ("ZGo shop not paid for" :: String)])
+          else do
+            status accepted202
+            Web.Scotty.json
+              (object ["message" .= ("Incorrect plugin config" :: String)])
   --Get user associated with session
   get "/api/user" $ do
     sess <- param "session"
diff --git a/stack.yaml b/stack.yaml
index 90dff48..f1db236 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -17,8 +17,8 @@
 #
 # resolver: ./custom-snapshot.yaml
 # resolver: https://example.com/snapshots/2018-01-01.yaml
-resolver:
-  url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/4.yaml
+resolver: lts-19.33
+  #url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/4.yaml
 
 # User packages to be built.
 # Various formats can be used as shown in the example below.
diff --git a/stack.yaml.lock b/stack.yaml.lock
index fa7fbb1..972fc8c 100644
--- a/stack.yaml.lock
+++ b/stack.yaml.lock
@@ -5,20 +5,19 @@
 
 packages:
 - completed:
+    commit: 085c16fb21b9f856a435a3faab980e7e0b319341
+    git: https://github.com/reach-sh/haskell-hexstring.git
     name: hexstring
-    version: 0.11.1
-    git: https://github.com/reach-sh/haskell-hexstring.git
     pantry-tree:
-      size: 687
       sha256: 9ecf67856f59dfb382b283eceb42e4fc1865935d1a7e59111556ed381c6a2ffd
-    commit: 085c16fb21b9f856a435a3faab980e7e0b319341
+      size: 687
+    version: 0.11.1
   original:
-    git: https://github.com/reach-sh/haskell-hexstring.git
     commit: 085c16fb21b9f856a435a3faab980e7e0b319341
+    git: https://github.com/reach-sh/haskell-hexstring.git
 snapshots:
 - completed:
-    size: 618683
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/4.yaml
-    sha256: d4ee004c46ba878d2f304f5d748d493057be579192a8d148527f3ba55c9df57f
-  original:
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/4.yaml
+    sha256: 6d1532d40621957a25bad5195bfca7938e8a06d923c91bc52aa0f3c41181f2d4
+    size: 619204
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/33.yaml
+  original: lts-19.33
diff --git a/test/Spec.hs b/test/Spec.hs
index e87364d..f2c4494 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -255,8 +255,8 @@ main = do
           it "generate token" pending
           it "authenticate with incorrect owner" $ do
             req <-
-              testGet
-                "/api/auth/"
+              testPublicGet
+                "/auth"
                 [ ("ownerid", Just "62cca13f5530331e2a900001")
                 , ("token", Just "89bd9d8d69a674e0f467cc8796ed151a")
                 , ("siteurl", Just "aHR0cHM6Ly93d3cudGVjcHJvdmFsLmNvbS8")
@@ -265,9 +265,9 @@ main = do
             getResponseStatus (res :: Response A.Value) `shouldBe` accepted202
           it "authenticate with incorrect token" $ do
             req <-
-              testGet
-                "/api/auth/"
-                [ ("ownerid", Just "62cca13f5530331e2a97c78e")
+              testPublicGet
+                "/auth"
+                [ ("ownerid", Just "627ad3492b05a76be3000001")
                 , ("token", Just "89bd9d8d69a674e0f467cc8796000000")
                 , ("siteurl", Just "aHR0cHM6Ly93d3cudGVjcHJvdmFsLmNvbS8")
                 ]
@@ -275,9 +275,9 @@ main = do
             getResponseStatus (res :: Response A.Value) `shouldBe` accepted202
           it "authenticate with correct token" $ do
             req <-
-              testGet
-                "/api/auth/"
-                [ ("ownerid", Just "62cca13f5530331e2a97c78e")
+              testPublicGet
+                "/auth"
+                [ ("ownerid", Just "627ad3492b05a76be3000001")
                 , ("token", Just "89bd9d8d69a674e0f467cc8796ed151a")
                 , ("siteurl", Just "aHR0cHM6Ly93d3cudGVjcHJvdmFsLmNvbS8")
                 ]
@@ -285,14 +285,28 @@ main = do
             getResponseStatus (res :: Response A.Value) `shouldBe` ok200
           it "authenticate with correct token on existing shop" $ do
             req <-
-              testGet
-                "/api/auth/"
-                [ ("ownerid", Just "62cca13f5530331e2a97c78e")
+              testPublicGet
+                "/auth"
+                [ ("ownerid", Just "627ad3492b05a76be3000001")
                 , ("token", Just "89bd9d8d69a674e0f467cc8796ed151a")
                 , ("siteurl", Just "aHR0cHM6Ly93d3cuZ29vZ2xlLmNvbS8")
                 ]
             res <- httpJSON req
             getResponseStatus (res :: Response A.Value) `shouldBe` accepted202
+          it "request order creation" $ do
+            req <-
+              testPublicGet
+                "/woopayment"
+                [ ("ownerid", Just "627ad3492b05a76be3000001")
+                , ("token", Just "89bd9d8d69a674e0f467cc8796ed151a")
+                , ("siteurl", Just "aHR0cHM6Ly93d3cudGVjcHJvdmFsLmNvbS8")
+                , ("order_id", Just "1234")
+                , ("currency", Just "usd")
+                , ("amount", Just "100.0")
+                , ("date", Just "2022-12-01")
+                ]
+            res <- httpJSON req
+            getResponseStatus (res :: Response A.Value) `shouldBe` ok200
     around handleDb $
       describe "Database actions" $ do
         describe "authentication" $ do
@@ -540,6 +554,15 @@ testGet endpoint body = do
         setRequestMethod "GET" $ setRequestPath endpoint defaultRequest
   return testRequest
 
+testPublicGet ::
+     B.ByteString -> [(B.ByteString, Maybe B.ByteString)] -> IO Request
+testPublicGet endpoint body = do
+  let testRequest =
+        setRequestQueryString body $
+        setRequestPort 3000 $
+        setRequestMethod "GET" $ setRequestPath endpoint defaultRequest
+  return testRequest
+
 testPost :: B.ByteString -> [(B.ByteString, Maybe B.ByteString)] -> IO Request
 testPost endpoint body = do
   let user = "user"
@@ -664,7 +687,7 @@ startAPI config = do
           ""
           "bubbarocks.io"
           "United States"
-          False
+          True
           False
           False
           (UTCTime (fromGregorian 2022 4 16) (secondsToDiffTime 0))
@@ -711,7 +734,7 @@ startAPI config = do
   let myWooToken =
         WooToken
           Nothing
-          (read "62cca13f5530331e2a97c78e")
+          (read "627ad3492b05a76be3000001")
           "89bd9d8d69a674e0f467cc8796ed151a"
           Nothing
   let wooTest = val myWooToken
diff --git a/zgo-backend.cabal b/zgo-backend.cabal
index a57aaf1..5698b56 100644
--- a/zgo-backend.cabal
+++ b/zgo-backend.cabal
@@ -1,6 +1,6 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.34.4.
+-- This file has been generated from package.yaml by hpack version 0.35.0.
 --
 -- see: https://github.com/sol/hpack
 
@@ -66,6 +66,7 @@ library
     , time
     , unordered-containers
     , vector
+    , wai
     , wai-cors
     , wai-extra
     , warp-tls

From be716378f08b48045124acb8b7fb5d2779fb907a Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Fri, 2 Dec 2022 14:43:52 -0600
Subject: [PATCH 05/16] Fix issue of multiple auth calls from WooCommerce

---
 src/ZGoBackend.hs | 28 ++++++++++++++++++++--------
 1 file changed, 20 insertions(+), 8 deletions(-)

diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index 0521464..1edac81 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -644,14 +644,26 @@ routes pipe config = do
                         , "message" .= ("Authorized!" :: String)
                         ])
                  else do
-                   status accepted202
-                   Web.Scotty.json
-                     (object
-                        [ "authorized" .= False
-                        , "message" .=
-                          ("ZGo shop already linked to" <>
-                           fromMaybe "" (w_url c))
-                        ])
+                   if (E.decodeUtf8With lenientDecode .
+                       B64.decodeLenient . C.pack . T.unpack)
+                        siteurl ==
+                      fromMaybe "" (w_url c)
+                     then do
+                       status ok200
+                       Web.Scotty.json
+                         (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

From 7dfd18b33a75830b01c94ef9e12cb5b855137d51 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Tue, 6 Dec 2022 11:04:05 -0600
Subject: [PATCH 06/16] 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

From e098d65297e68f17a7b122c76b03a23babe0fc6e Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Tue, 6 Dec 2022 12:09:35 -0600
Subject: [PATCH 07/16] Fix WooCommerce API call

---
 src/WooCommerce.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/src/WooCommerce.hs b/src/WooCommerce.hs
index 3544c15..02e17e2 100644
--- a/src/WooCommerce.hs
+++ b/src/WooCommerce.hs
@@ -60,7 +60,7 @@ payWooOrder ::
   -> BS.ByteString -- Total ZEC for order
   -> IO ()
 payWooOrder u i o t p z = do
-  wooReq <- parseRequest u
+  wooReq <- parseRequest $ u ++ "wc-api/zpmtcallback"
   let req =
         setRequestQueryString
           [ ("token", Just t)
@@ -70,6 +70,7 @@ payWooOrder u i o t p z = do
           , ("totalzec", Just z)
           ]
           wooReq
+  print req
   res <- httpLBS req
   if getResponseStatus res == ok200
     then return ()

From 02ecc305faedb8fdda0728e0c44672de9c01b16f Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Tue, 6 Dec 2022 12:40:58 -0600
Subject: [PATCH 08/16] Fix session assignment for WooCommerce

---
 src/ZGoBackend.hs | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index 897e666..0d9c01c 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -714,7 +714,9 @@ routes pipe config = do
                               ZGoOrder
                                 Nothing
                                 (oaddress o)
-                                ("WC-" <> (T.pack . show $ o_id o))
+                                (case o_id o of
+                                   Just o' -> "WC-" <> (T.pack . show $ o')
+                                   Nothing -> "")
                                 (parseTimeOrError
                                    True
                                    defaultTimeLocale

From ac2ecd736850c0eef9df6c4fde5772fd4c0dc2a3 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Tue, 6 Dec 2022 13:35:11 -0600
Subject: [PATCH 09/16] Fix WooCommerce API path

---
 src/WooCommerce.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/WooCommerce.hs b/src/WooCommerce.hs
index 02e17e2..e062468 100644
--- a/src/WooCommerce.hs
+++ b/src/WooCommerce.hs
@@ -60,7 +60,7 @@ payWooOrder ::
   -> BS.ByteString -- Total ZEC for order
   -> IO ()
 payWooOrder u i o t p z = do
-  wooReq <- parseRequest $ u ++ "wc-api/zpmtcallback"
+  wooReq <- parseRequest $ u ++ "/wc-api/zpmtcallback"
   let req =
         setRequestQueryString
           [ ("token", Just t)

From 694b16bba56779f0580e5230b280fe2655126660 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Tue, 6 Dec 2022 14:35:13 -0600
Subject: [PATCH 10/16] Fix call to payWooOrder

---
 src/ZGoBackend.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index 0d9c01c..90fc0fd 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -1153,8 +1153,8 @@ scanPayments config pipe = do
                                payWooOrder
                                  (T.unpack wUrl)
                                  (C.pack iNum)
-                                 (C.pack . show $ maybe "" show (q_id xO))
-                                 (C.pack . show $ w_owner wt)
+                                 (C.pack $ maybe "" show (q_id xO))
+                                 (C.pack . show $ w_token wt)
                                  (C.pack . show $ qprice xO)
                                  (C.pack . show $ qtotalZec xO)
                              else error

From d5bbf5e30ce5ec8f715c88e1022a709f6f0d0806 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Tue, 6 Dec 2022 16:35:04 -0600
Subject: [PATCH 11/16] Fix WooCommerce token for payment

---
 src/ZGoBackend.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index 90fc0fd..7d6f002 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -1154,7 +1154,7 @@ scanPayments config pipe = do
                                  (T.unpack wUrl)
                                  (C.pack iNum)
                                  (C.pack $ maybe "" show (q_id xO))
-                                 (C.pack . show $ w_token wt)
+                                 (C.pack . T.unpack $ w_token wt)
                                  (C.pack . show $ qprice xO)
                                  (C.pack . show $ qtotalZec xO)
                              else error

From cb9b5cd411c6f497c85dffcd3e9af4b45b661189 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Tue, 13 Dec 2022 14:01:51 -0600
Subject: [PATCH 12/16] Add WC Order Key to payment flow

---
 src/ZGoBackend.hs | 6 ++++--
 test/Spec.hs      | 1 +
 2 files changed, 5 insertions(+), 2 deletions(-)

diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index 7d6f002..4261731 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -678,6 +678,7 @@ 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
@@ -733,7 +734,8 @@ routes pipe config = do
                                     amount
                                 ]
                                 False
-                                (T.concat [T.pack sUrl, "-", ordId])
+                                (T.concat
+                                   [T.pack sUrl, "-", ordId, "-", orderKey])
                                 ""
                         newId <- liftAndCatchIO $ run (insertWooOrder newOrder)
                         status ok200
@@ -1138,7 +1140,7 @@ scanPayments config pipe = do
                        case wT of
                          Nothing -> error "Failed to read WooCommerce token"
                          Just wt -> do
-                           let iReg = mkRegex "(.*)-(.*)"
+                           let iReg = mkRegex "(.*)-(.*)-.*"
                            let iResult =
                                  matchAllText
                                    iReg
diff --git a/test/Spec.hs b/test/Spec.hs
index f2c4494..6e6a943 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -304,6 +304,7 @@ 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

From e4129b2970a691449453ce35acc542eb07967d7c Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Thu, 15 Dec 2022 15:47:02 -0600
Subject: [PATCH 13/16] Add endpoint to query WooCommerce token

---
 src/ZGoBackend.hs | 15 +++++++++++++++
 1 file changed, 15 insertions(+)

diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index 4261731..0438fb9 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -618,6 +618,21 @@ 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"

From 9fb2149488323759c4bf84030d3ef38a0e45f082 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Mon, 26 Dec 2022 08:20:50 -0600
Subject: [PATCH 14/16] Fix bug #2

---
 src/ZGoBackend.hs | 7 +++++--
 1 file changed, 5 insertions(+), 2 deletions(-)

diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index 0438fb9..4d2dc7b 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -8,6 +8,7 @@ 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
@@ -1041,8 +1042,10 @@ getZcashPrices = do
 -- | Function to update the Zcash prices in the ZGo db
 checkZcashPrices :: Pipe -> T.Text -> IO ()
 checkZcashPrices p db = do
-  q <- getZcashPrices
-  mapM_ (access p master db) (updatePrices (getResponseBody q))
+  q <- try getZcashPrices
+  case q of
+    Left e -> print (e :: HttpException)
+    Right q1 -> mapM_ (access p master db) (updatePrices (getResponseBody q1))
 
 -- | Function to search for transactions for an address
 listTxs ::

From 3ee62357872e143d22f071ecfd72f7076cfe72fa Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Tue, 3 Jan 2023 13:00:24 -0600
Subject: [PATCH 15/16] Implement API endpoint to generate token

---
 package.yaml       |  3 +++
 src/WooCommerce.hs | 23 +++++++++++++++++++++++
 src/ZGoBackend.hs  |  9 +++++++++
 stack.yaml         |  1 +
 stack.yaml.lock    |  7 +++++++
 test/Spec.hs       | 35 ++++++++++++++++++++++++++++++++++-
 zgo-backend.cabal  |  3 +++
 7 files changed, 80 insertions(+), 1 deletion(-)

diff --git a/package.yaml b/package.yaml
index c996c29..a4fa9f5 100644
--- a/package.yaml
+++ b/package.yaml
@@ -55,6 +55,9 @@ library:
   - containers
   - base64-bytestring
   - wai
+  - blake3
+  - memory
+  - ghc-prim
 
 executables:
   zgo-backend-exe:
diff --git a/src/WooCommerce.hs b/src/WooCommerce.hs
index e062468..a7b16b4 100644
--- a/src/WooCommerce.hs
+++ b/src/WooCommerce.hs
@@ -2,8 +2,10 @@
 
 module WooCommerce where
 
+import qualified BLAKE3 as BLK
 import Data.Aeson
 import qualified Data.Bson as B
+import qualified Data.ByteArray as BA
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Base64 as B64
 import qualified Data.ByteString.Char8 as C
@@ -14,6 +16,7 @@ import Data.Text.Encoding.Error (lenientDecode)
 import Database.MongoDB
 import Network.HTTP.Simple
 import Network.HTTP.Types.Status
+import Owner
 
 -- | Type to represent the WooCommerce token
 data WooToken =
@@ -75,3 +78,23 @@ payWooOrder u i o t p z = do
   if getResponseStatus res == ok200
     then return ()
     else error "Failed to report payment to WooCommerce"
+
+generateWooToken :: Owner -> Action IO ()
+generateWooToken o =
+  case o_id o of
+    Just ownerid -> do
+      let tokenHash =
+            BLK.hash
+              [ BA.pack . BS.unpack . C.pack . T.unpack $ oname o <> oaddress o :: BA.Bytes
+              ]
+      let wooToken =
+            val $
+            WooToken
+              Nothing
+              ownerid
+              (T.pack . show $ (tokenHash :: BLK.Digest BLK.DEFAULT_DIGEST_LEN))
+              Nothing
+      case wooToken of
+        Doc wT -> insert_ "wootokens" wT
+        _ -> error "Couldn't create the WooCommerce token"
+    Nothing -> error "Bad owner id"
diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index 4d2dc7b..78728e4 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -634,6 +634,15 @@ routes pipe config = do
              , "token" .= w_token t
              , "siteurl" .= w_url t
              ])
+  post "/api/wootoken" $ do
+    oid <- param "ownerid"
+    res <- liftAndCatchIO $ run (findOwnerById oid)
+    let o1 = cast' . Doc =<< res
+    case o1 of
+      Nothing -> status noContent204
+      Just o -> do
+        liftAndCatchIO $ run (generateWooToken o)
+        status accepted202
   -- Authenticate the WooCommerce plugin
   get "/auth" $ do
     oid <- param "ownerid"
diff --git a/stack.yaml b/stack.yaml
index f1db236..27fad16 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -44,6 +44,7 @@ packages:
 extra-deps:
   - git: https://github.com/reach-sh/haskell-hexstring.git
     commit: 085c16fb21b9f856a435a3faab980e7e0b319341
+  - blake3-0.2@sha256:d1146b9a51ccfbb0532780778b6d016a614e3d44c05d8c1923dde9a8be869045,2448
 # Override default flag values for local packages and extra-deps
 # flags: {}
 
diff --git a/stack.yaml.lock b/stack.yaml.lock
index 972fc8c..ad88f96 100644
--- a/stack.yaml.lock
+++ b/stack.yaml.lock
@@ -15,6 +15,13 @@ packages:
   original:
     commit: 085c16fb21b9f856a435a3faab980e7e0b319341
     git: https://github.com/reach-sh/haskell-hexstring.git
+- completed:
+    hackage: blake3-0.2@sha256:d1146b9a51ccfbb0532780778b6d016a614e3d44c05d8c1923dde9a8be869045,2448
+    pantry-tree:
+      sha256: 0264ef3e7919e7b0d668c4153f6ce0d88e6965626b52d9dfd2cafd70309501d3
+      size: 1433
+  original:
+    hackage: blake3-0.2@sha256:d1146b9a51ccfbb0532780778b6d016a614e3d44c05d8c1923dde9a8be869045,2448
 snapshots:
 - completed:
     sha256: 6d1532d40621957a25bad5195bfca7938e8a06d923c91bc52aa0f3c41181f2d4
diff --git a/test/Spec.hs b/test/Spec.hs
index 6e6a943..6d1137d 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -252,7 +252,13 @@ main = do
             res <- httpLBS req
             getResponseStatus res `shouldBe` ok200
         describe "WooCommerce endpoints" $ do
-          it "generate token" pending
+          it "generate token" $ do
+            req <-
+              testPost
+                "/api/wootoken"
+                [("ownerid", Just "627ad3492b05a76be5000001")]
+            res <- httpLBS req
+            getResponseStatus res `shouldBe` accepted202
           it "authenticate with incorrect owner" $ do
             req <-
               testPublicGet
@@ -695,6 +701,33 @@ startAPI config = do
           False
           ""
           ""
+  let myOwner1 =
+        Owner
+          (Just (read "627ad3492b05a76be5000001"))
+          "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
+          "Test shop"
+          "usd"
+          False
+          0
+          False
+          0
+          "Bubba"
+          "Gibou"
+          "bubba@zgo.cash"
+          "1 Main St"
+          "Mpls"
+          "Minnesota"
+          "55401"
+          ""
+          "bubbarocks.io"
+          "United States"
+          True
+          False
+          False
+          (UTCTime (fromGregorian 2022 4 16) (secondsToDiffTime 0))
+          False
+          ""
+          ""
   _ <- access pipe master "test" (Database.MongoDB.delete (select [] "owners"))
   let o = val myOwner
   case o of
diff --git a/zgo-backend.cabal b/zgo-backend.cabal
index 5698b56..34fee47 100644
--- a/zgo-backend.cabal
+++ b/zgo-backend.cabal
@@ -46,14 +46,17 @@ library
     , array
     , base >=4.7 && <5
     , base64-bytestring
+    , blake3
     , bson
     , bytestring
     , configurator
     , containers
+    , ghc-prim
     , hexstring
     , http-conduit
     , http-types
     , jwt
+    , memory
     , mongoDB
     , quickcheck-instances
     , random

From 8680d5d0d9c88d26f911d93fa998b908b28c3eb5 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Mon, 9 Jan 2023 10:01:44 -0600
Subject: [PATCH 16/16] Version release preparation

---
 CHANGELOG.md | 3 ++-
 package.yaml | 6 +++---
 2 files changed, 5 insertions(+), 4 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 5c2e2a3..b1d7ebe 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -4,7 +4,7 @@ All notable changes to this project will be documented in this file.
 The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
 and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).
 
-## [Unreleased]
+## [1.2.0] - 2023-01-09
 
 ### Added
 
@@ -12,6 +12,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 - New module for WooCommerce interaction.
 - New `/auth` endpoint to authenticate with the WooCommerce plugin and corresponding tests
 - New `/woopayment` endpoint to generate a new order from the WooCommerce plugin and corresponding tests
+- New `/wootoken` endpoint to generate a new token and query the token from the database.
 
 ### Changed
 
diff --git a/package.yaml b/package.yaml
index a4fa9f5..8c5b0b3 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,6 +1,6 @@
 name:                zgo-backend
-version:             1.1.1
-git:                 "https://gitlab.com/pitmutt/zgo-backend"
+version:             1.2.0
+git:                 "https://git.vergara.tech/Vergara_Tech/zgo-backend"
 license:             BOSL
 author:              "Rene Vergara"
 maintainer:          "rene@vergara.network"
@@ -18,7 +18,7 @@ category:            Web
 # To avoid duplicated efforts in documentation and dealing with the
 # complications of embedding Haddock markup inside cabal files, it is
 # common to point users to the README.md file.
-description:         Please see the README on GitLab at <https://gitlab.com/pitmutt/zgo-backend#readme>
+description:         Please see the README at <https://git.vergara.tech/Vergara_Tech//zgo-backend#readme>
 
 dependencies:
 - base >= 4.7 && < 5