Implement API endpoint to generate token

package.yaml

@@ -55,6 +55,9 @@ library:
   - containers
   - base64-bytestring
   - wai
+  - blake3
+  - memory
+  - ghc-prim
 
 executables:
   zgo-backend-exe:

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"

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"

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: {}
 

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

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

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