feat(Std-crud): Support json patch edit format

code/project.clj

@@ -80,7 +80,8 @@
                                   [com.github.kenglxn.qrgen/javase]
                                   [com.google.zxing/javase]]]
    [funcool/promesa "11.0.678"]
-   [nrepl "1.1.1"]]
+   [nrepl "1.1.1"]
+   [clj-json-patch "0.1.7"]]
 
   :profiles
   {:provided {:dependencies [[org.clojure/clojure "1.11.2"]

code/src/com/sixsq/nuvla/server/resources/common/std_crud.clj

@@ -7,6 +7,7 @@
     [clojure.walk :as w]
     [com.sixsq.nuvla.auth.acl-resource :as a]
     [com.sixsq.nuvla.auth.utils :as auth]
+    [clj-json-patch.core :as json-patch]
     [com.sixsq.nuvla.db.impl :as db]
     [com.sixsq.nuvla.server.middleware.cimi-params.impl :as impl]
     [com.sixsq.nuvla.server.resources.common.crud :as crud]
@@ -62,6 +63,28 @@
       (catch Exception e
         (or (ex-data e) (throw e))))))
 
+(defn json-safe-patch
+  [obj patches]
+  (try
+    (if-let [result (json-patch/patch obj patches)]
+      result
+      (throw (Exception. "Patch interpretation failed!")))
+    (catch Exception e
+      (log/debug "Json patch exception - ex-message:" (ex-message e) "ex-data:" (ex-data e) "exception:" e "resource:" (prn-str obj) "patches:" (prn-str (vec patches)))
+      (throw (r/ex-bad-request (str "Json patch exception: " (ex-message e)))))))
+
+(defn- json-patch-request? [request]
+  (= (get-in request [:headers "content-type"]) "application/json-patch+json"))
+
+(defn json-patch
+  [resource {:keys [body] :as request}]
+  (if (json-patch-request? request)
+    (->> (w/stringify-keys body)
+         (json-safe-patch (w/stringify-keys resource))
+         w/keywordize-keys
+         (assoc request :body))
+    request))
+
 
 (defn edit-fn
   [resource-name & {:keys [pre-validate-hook
@@ -73,19 +96,21 @@
                            immutable-keys        []}}]
   (fn [{{uuid :uuid} :params :as request}]
     (try
-      (-> (str resource-name "/" uuid)
-          db/retrieve
-          (a/throw-cannot-edit request)
-          (sm/throw-can-not-do-action request)
-          (pre-delete-attrs-hook request)
-          (u/delete-attributes request immutable-keys)
-          u/update-timestamps
-          (u/set-updated-by request)
-          (pre-validate-hook request)
-          (dissoc :operations)
-          crud/validate
-          (db/edit options)
-          (update :body crud/set-operations request))
+      (let [resource (-> (str resource-name "/" uuid)
+                         db/retrieve
+                         (a/throw-cannot-edit request)
+                         (sm/throw-can-not-do-action request))
+            request  (json-patch resource request)]
+        (-> resource
+            (pre-delete-attrs-hook request)
+            (u/delete-attributes request immutable-keys)
+            u/update-timestamps
+            (u/set-updated-by request)
+            (pre-validate-hook request)
+            (dissoc :operations)
+            crud/validate
+            (db/edit options)
+            (update :body crud/set-operations request)))
       (catch Exception e
         (or (ex-data e) (throw e))))))
 

code/src/com/sixsq/nuvla/server/resources/nuvlabox_status.clj

@@ -123,7 +123,10 @@ Versioned subclasses define the attributes for a particular NuvlaBox release.
                       ex))]
     (if exception
       (do
-        (crud/edit (dissoc request :body))
+        (-> request
+            (assoc-in [:headers "content-type"] "application/json")
+            (dissoc request :body)
+            crud/edit)
         (throw exception))
       resource)))
 

code/src/com/sixsq/nuvla/server/resources/spec/nuvlabox_status_2.cljc

@@ -217,6 +217,13 @@
 
              :json-schema/order 88)))
 
+(s/def ::coe-resources
+  (assoc (st/spec map?)
+    :name "coe-resources"
+    :json-schema/type "map"
+    :json-schema/indexed false
+    :json-schema/description "coe resources info"))
+
 
 (s/def ::schema
   (su/only-keys-maps common/common-attrs
@@ -260,5 +267,6 @@
                                ::orchestrator
                                ::nb-status-0/temperatures
                                ::components
-                               ::network]}))
+                               ::network
+                               ::coe-resources]}))
 

code/test/com/sixsq/nuvla/server/resources/nuvlabox_status_2_lifecycle_test.clj

@@ -264,6 +264,50 @@
                 (doseq [k nb-status/blacklist-response-keys]
                   (is (not (contains? r k)))))))
 
+          (let [new-tags ["foo"]]
+            (testing "nuvlabox user is able to patch update nuvlabox-status"
+              (-> session-nb
+                  (request status-url
+                           :content-type "application/json-patch+json"
+                           :request-method :put
+                           :body (json/write-str [{"op" "add" "path" "/tags" "value" new-tags}
+                                                  {"op" "test" "path" "/tags" "value" new-tags}]))
+                  (ltu/body->edn)
+                  (ltu/is-status 200))
+              (testing "spec error are returned to the user"
+                (-> session-nb
+                    (request status-url
+                             :content-type "application/json-patch+json"
+                             :request-method :put
+                             :body (json/write-str [{"op" "add" "path" "/foo" "value" "x"}]))
+                    (ltu/body->edn)
+                    (ltu/is-status 400)))
+              (testing "patch error are returned to the user"
+                (-> session-nb
+                    (request status-url
+                             :content-type "application/json-patch+json"
+                             :request-method :put
+                             :body (json/write-str [{"op" "test" "path" "/tags" "value" []}]))
+                    (ltu/body->edn)
+                    (ltu/is-status 400)
+                    (ltu/message-matches "Json patch exception: The test failed. [] is not found at /tags"))
+                (-> session-nb
+                    (request status-url
+                             :content-type "application/json-patch+json"
+                             :request-method :put
+                             :body (json/write-str [{"op" "remove" "path" "/wrong/1" "value" "x"}]))
+                    (ltu/body->edn)
+                    (ltu/is-status 400)
+                    (ltu/message-matches "Json patch exception: There is no value at '/wrong/1' to remove."))
+                (-> session-nb
+                    (request status-url
+                             :content-type "application/json-patch+json"
+                             :request-method :put
+                             :body (json/write-str "plain text"))
+                    (ltu/body->edn)
+                    (ltu/is-status 400)
+                    (ltu/message-matches "Json patch exception: Patch interpretation failed!")))))
+
           (testing "nuvlabox identity cannot delete the state"
             (-> session-nb
                 (request status-url

code/test/com/sixsq/nuvla/server/resources/spec/nuvlabox_status_2_test.cljc

@@ -128,7 +128,8 @@
                                                         :ips       [{:address "3.4.5.6"}]}
                                                        {:interface "enp3s0"
                                                         :ips       []}
-                                                       {:interface "abc"}]}})
+                                                       {:interface "abc"}]}
+            :coe-resources               {:docker {}}})
 
 
 (deftest check-nuvlabox-status
@@ -149,5 +150,5 @@
                  :power-consumption ::jobs :swarm-node-cert-expiry-date :online :host-user-home
                  :cluster-id :cluster-node-labels :cluster-node-role :status-notes :cluster-nodes
                  :cluster-managers :orchestrator :cluster-join-address :temperatures :components
-                 :network}]
+                 :network :coe-resources}]
     (stu/is-valid ::nb-status-2/schema (dissoc state attr))))