Add tests for random WooToken

src/WooCommerce.hs

@@ -31,27 +31,25 @@ data WooToken =
 instance FromJSON WooToken where
   parseJSON =
     withObject "WooToken" $ \obj -> do
-      i <- obj .: "_id"
-      o <- obj .: "owner"
+      i <- obj .:? "_id"
+      o <- obj .: "ownerid"
       t <- obj .: "token"
-      u <- obj .: "url"
-      pure $
-        WooToken
-          (if not (null i)
-             then Just (read i)
-             else Nothing)
-          (read o)
-          t
-          u
+      u <- obj .: "siteurl"
+      pure $ WooToken (read <$> i) (read o) t u
 
 instance ToJSON WooToken where
   toJSON (WooToken i o t u) =
     case i of
       Just oid ->
-        object ["_id" .= show oid, "owner" .= show o, "token" .= t, "url" .= u]
+        object
+          ["_id" .= show oid, "ownerid" .= show o, "token" .= t, "siteurl" .= u]
       Nothing ->
         object
-          ["_id" .= ("" :: String), "owner" .= show o, "token" .= t, "url" .= u]
+          [ "_id" .= ("" :: String)
+          , "ownerid" .= show o
+          , "token" .= t
+          , "siteurl" .= u
+          ]
 
 instance Val WooToken where
   val (WooToken i o t u) =

test/Spec.hs

@@ -13,6 +13,7 @@ import Data.Either
 import Data.Maybe
 import Data.SecureMem
 import qualified Data.Text as T
+import qualified Data.Text.Encoding as E
 import Data.Time
 import Data.Time.Calendar
 import Data.Time.Clock
@@ -594,6 +595,20 @@ main = do
                 ]
             res <- httpLBS req
             getResponseStatus res `shouldBe` accepted202
+          it "read token gives 401 with bad session" $ do
+            req <-
+              testGet
+                "/api/wootoken"
+                [("session", Just "35bfb9c2-9ad2-4fe5-fake-99d63b8dcdcd")]
+            res <- httpLBS req
+            getResponseStatus res `shouldBe` unauthorized401
+          it "read token succeeds with valid session" $ do
+            req <-
+              testGet
+                "/api/wootoken"
+                [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
+            res <- httpJSON req
+            getResponseStatus (res :: Response A.Value) `shouldBe` ok200
           it "authenticate with incorrect owner" $ do
             req <-
               testPublicGet
@@ -617,13 +632,17 @@ main = do
             res <- httpJSON req
             getResponseStatus (res :: Response A.Value) `shouldBe` accepted202
           it "authenticate with correct token" $ do
+            req1 <-
+              testGet
+                "/api/wootoken"
+                [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
+            res1 <- httpJSON req1
+            let tk = getResponseBody (res1 :: Response WooToken)
             req <-
               testPublicGet
                 "/auth"
                 [ ("ownerid", Just "627ad3492b05a76be3000001")
-                , ( "token"
-                  , Just
-                      "0c1702c16c7bd7e075b8bb129b24888a5cc2181fa1eb4ce9190cfcb625ecf0ee")
+                , ("token", Just $ (E.encodeUtf8 . w_token) tk)
                 , ("siteurl", Just "aHR0cHM6Ly93d3cudGVjcHJvdmFsLmNvbS8")
                 ]
             res <- httpJSON req
@@ -641,13 +660,17 @@ main = do
             res <- httpJSON req
             getResponseStatus (res :: Response A.Value) `shouldBe` accepted202
           it "request order creation" $ do
+            req1 <-
+              testGet
+                "/api/wootoken"
+                [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
+            res1 <- httpJSON req1
+            let tk = getResponseBody (res1 :: Response WooToken)
             req <-
               testPublicGet
                 "/woopayment"
                 [ ("ownerid", Just "627ad3492b05a76be3000001")
-                , ( "token"
-                  , Just
-                      "0c1702c16c7bd7e075b8bb129b24888a5cc2181fa1eb4ce9190cfcb625ecf0ee")
+                , ("token", Just $ (E.encodeUtf8 . w_token) tk)
                 , ("siteurl", Just "aHR0cHM6Ly93d3cudGVjcHJvdmFsLmNvbS8")
                 , ("order_id", Just "1234")
                 , ("currency", Just "usd")
@@ -1143,11 +1166,42 @@ startAPI config = do
           False
           ""
           ""
+  let myOwner1 =
+        Owner
+          (Just (read "627ad3492b05a76be3000008"))
+          "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3fake"
+          "Test shop 2"
+          "usd"
+          False
+          0
+          False
+          0
+          "Roxy"
+          "Foo"
+          "roxy@zgo.cash"
+          "1 Main St"
+          "Mpls"
+          "Minnesota"
+          "55401"
+          ""
+          "missyfoo.io"
+          "United States"
+          True
+          False
+          False
+          (UTCTime (fromGregorian 2023 8 6) (secondsToDiffTime 0))
+          False
+          ""
+          ""
   _ <- access pipe master "test" (Database.MongoDB.delete (select [] "owners"))
   let o = val myOwner
   case o of
     Doc d -> access pipe master "test" (insert_ "owners" d)
     _ -> fail "Couldn't save Owner in DB"
+  let o1 = val myOwner1
+  case o1 of
+    Doc d1 -> access pipe master "test" (insert_ "owners" d1)
+    _ -> fail "Couldn't save Owner1 in DB"
   _ <- access pipe master "test" (Database.MongoDB.delete (select [] "orders"))
   myTs <- liftIO getCurrentTime
   let myOrder =