Implement WooCommerce order creation

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
 

package.yaml

@@ -54,6 +54,7 @@ library:
   - jwt
   - containers
   - base64-bytestring
+  - wai
 
 executables:
   zgo-backend-exe:

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

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
+    let c1 = cast' . Doc =<< res
-    case c of
+    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"

stack.yaml

@@ -17,8 +17,8 @@
 #
 # resolver: ./custom-snapshot.yaml
 # resolver: https://example.com/snapshots/2018-01-01.yaml
-resolver:
+resolver: lts-19.33
-  url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/4.yaml
+  #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.

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
+    sha256: 6d1532d40621957a25bad5195bfca7938e8a06d923c91bc52aa0f3c41181f2d4
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/4.yaml
+    size: 619204
-    sha256: d4ee004c46ba878d2f304f5d748d493057be579192a8d148527f3ba55c9df57f
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/33.yaml
-  original:
+  original: lts-19.33
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/4.yaml

test/Spec.hs

@@ -255,8 +255,8 @@ main = do
           it "generate token" pending
           it "authenticate with incorrect owner" $ do
             req <-
-              testGet
+              testPublicGet
-                "/api/auth/"
+                "/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
+              testPublicGet
-                "/api/auth/"
+                "/auth"
-                [ ("ownerid", Just "62cca13f5530331e2a97c78e")
+                [ ("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
+              testPublicGet
-                "/api/auth/"
+                "/auth"
-                [ ("ownerid", Just "62cca13f5530331e2a97c78e")
+                [ ("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
+              testPublicGet
-                "/api/auth/"
+                "/auth"
-                [ ("ownerid", Just "62cca13f5530331e2a97c78e")
+                [ ("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

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