Add new JSON serialization for WooToken

CHANGELOG.md

@@ -6,6 +6,10 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 
 ## [1.6.0]
 
+### Added
+
+- New JSON serialization for WooTokens.
+
 ### Changed
 
 - Modified the process to mark paid orders to ensure only payments to the shop's wallet get marked as paid

src/WooCommerce.hs

@@ -28,6 +28,31 @@ data WooToken =
     }
   deriving (Eq, Show)
 
+instance FromJSON WooToken where
+  parseJSON =
+    withObject "WooToken" $ \obj -> do
+      i <- obj .: "_id"
+      o <- obj .: "owner"
+      t <- obj .: "token"
+      u <- obj .: "url"
+      pure $
+        WooToken
+          (if not (null i)
+             then Just (read i)
+             else Nothing)
+          (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]
+      Nothing ->
+        object
+          ["_id" .= ("" :: String), "owner" .= show o, "token" .= t, "url" .= u]
+
 instance Val WooToken where
   val (WooToken i o t u) =
     if isJust i
@@ -82,21 +107,11 @@ payWooOrder u i o t p z = do
     then return ()
     else error "Failed to report payment to WooCommerce"
 
-generateWooToken :: Owner -> Action IO ()
+generateWooToken :: Owner -> String -> Action IO ()
-generateWooToken o =
+generateWooToken o s =
   case o_id o of
     Just ownerid -> do
-      let tokenHash =
+      let wooToken = val $ WooToken Nothing ownerid (T.pack s) Nothing
-            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"

src/ZGoBackend.hs

@@ -736,7 +736,8 @@ routes pipe config = do
           Just o -> do
             if oaddress o == uaddress u
               then do
-                liftAndCatchIO $ run (generateWooToken o)
+                tk <- liftIO generateToken
+                liftAndCatchIO $ run (generateWooToken o tk)
                 status accepted202
               else status forbidden403
   -- Authenticate the WooCommerce plugin
@@ -753,7 +754,7 @@ routes pipe config = do
           (object
              ["authorized" .= False, "message" .= ("Owner not found" :: String)])
       Just c ->
-        if t == w_token c
+        if blk3Hash t == blk3Hash (T.unpack $ w_token c)
           then if isNothing (w_url c)
                  then do
                    liftAndCatchIO $ run (addUrl c siteurl)
@@ -791,6 +792,10 @@ routes pipe config = do
                  [ "authorized" .= False
                  , "message" .= ("Token mismatch" :: String)
                  ])
+        where blk3Hash :: String -> String
+              blk3Hash s =
+                show
+                  (BLK.hash [BA.pack . BS.unpack . C.pack $ s :: BA.Bytes] :: BLK.Digest BLK.DEFAULT_DIGEST_LEN)
   get "/woopayment" $ do
     oid <- param "ownerid"
     t <- param "token"