Implement WooCommerce authentication

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
 

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]]

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"

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!"
 

zgo-backend.cabal

@@ -32,6 +32,7 @@ library
       Owner
       Payment
       User
+      WooCommerce
       Xero
       ZGoBackend
       ZGoTx