Implement WooCommerce order creation

2022-12-01 14:36:06 -06:00 · 2022-12-01 14:36:06 -06:00 · 3683567b81
commit 3683567b81
parent ebb87feee6
8 changed files with 153 additions and 31 deletions
--- 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

--- a/package.yaml
+++ b/package.yaml
@ -54,6 +54,7 @@ library:
  - jwt
  - containers
  - base64-bytestring
+  - wai

 executables:
  zgo-backend-exe:
--- 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
--- 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"
--- 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.
--- 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
--- 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
--- 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