Save compaction

CHANGELOG.md

@@ -22,6 +22,7 @@ Changes since v2.27
 - Default `robots.txt` has been included that indexes everything but the `/api`. NB: the bots are not able to index most pages as they are behind the login. (#2680)
 - HTTP/2 (and others) can be configured, see `:jetty-extra-params` in `config-defaults.edn`.
 - Validate organization when adding or editing it. (#2964)
+- Consecutive save events are compacted into one. This does not affect old save events. This is turned off by default, until the whole autosave feature is finished. (#2767)
 
 ### Fixes
 - Add missing migration to remove organization modifier and last modified from the data. (#2964)

docs/architecture/017-applicant-ux.md

@@ -38,6 +38,10 @@ Idea: Think of REMS validations more like spellchecking and less like
 validations. Higlight in red things that the applicant will want to
 fix, but don't prevent saving.
 
+### 2022-04-06 Save succeeds even with validation errors
+
+Draft saving succeeds again even with validation errors. This is implemented in the PR #2766. Validation errors are now shown in yellow.
+
 ## B) Validation errors are shown late
 
 You need to perform an action (save/submit) to see the validation
@@ -79,9 +83,15 @@ separately from the application events.
 Note: in both of these cases we would also retain the current Save
 button.
 
-# TODO Decision
+### 2021-06-18 Consecutive save compaction
+
+The PR #2966 implements consecutive save compaction, making consecutive saves in one event.
+The last save event is updated, with a new save event including id and data.
+Process managers and notifications are sent as before.
+
+# 2021-11-02 Decision
 
-Here's a step-by-step plan for fixing these. We might not end up doing all of the steps.
+Here's a step-by-step plan for fixing these.
 
 1. (Problem A) Make save succeed even with validation errors. Show validation errors in yellow (instead of red). [#2766](https://github.com/CSCfi/rems/issues/2766)
 2. (Problem B) Run validations in the frontend after the user has stopped typing. [#2614](https://github.com/CSCfi/rems/issues/2614)

resources/config-defaults.edn

@@ -23,7 +23,8 @@
  ;; When :nrepl-port is set, the application starts an nREPL server on load.
  :nrepl-port nil
 
- ;; When true, enables experimental and unfinished features.
+ ;; When true, enables development features
+ ;; (should not be turned on in production)
  :dev false
 
  ;; Uses :database-url if it's defined. Otherwise :database-jndi-name is used.
@@ -358,15 +359,14 @@
  ;; https://en.wikipedia.org/wiki/ISO_8601#Durations for duration formatting reference.
  :application-expiration nil
 
-
- ;; Experimental features
-
  ;; enable /api/applications/:id/experimental/pdf
+ ;; PDF API (experimental)
  :enable-pdf-api false
 
  ;; enable /api/permissions/:user
  ;; see also docs/ga4gh-visas.md
  :enable-permissions-api false
+
  ;; Keys for signing GA4GH Visas produced by permissions api or sent to EGA.
  ;; Format: path to file containing key in JWK (Json Web Key) format
  :ga4gh-visa-private-key nil
@@ -389,5 +389,7 @@
  :enable-catalogue-table true ; show catalogue page table of items
  :enable-catalogue-tree false ; show catalogue page tree of items
  :catalogue-tree-show-matching-parents true ; should parent categories be shown if children match?
-
- :enable-cart true} ; show shopping cart and allow bundling multiple resources into one application
+
+ :enable-cart true ; show shopping cart and allow bundling multiple resources into one application
+
+ :enable-save-compaction nil} ; whether to merge consecutive saves into one event (EXPERIMENTAL)

resources/sql/queries.sql

@@ -605,6 +605,12 @@ UPDATE application_event
 SET (appId, eventData) = (:application, :eventdata::jsonb)
 WHERE id = :id;
 
+-- :name replace-application-event! :returning-execute :1
+UPDATE application_event
+SET (id, appId, eventData) = (DEFAULT, :application, :eventdata::jsonb)
+WHERE id = :id
+RETURNING id, eventData::TEXT;
+
 -- :name delete-application-events! :!
 DELETE FROM application_event
 WHERE appId = :application;

src/clj/rems/api/services/command.clj

@@ -83,14 +83,15 @@
   (let [app (when-let [app-id (:application-id cmd)]
               (applications/get-application-internal app-id))
         result (commands/handle-command cmd app command-injections)]
-    (when-not (:errors result)
-      (let [events-from-db (mapv events/add-event! (:events result))]
+    (if-not (:errors result)
+      (let [events-from-db (mapv #(events/add-event-with-compaction! app %) (:events result))]
         (doseq [cmd2 (run-process-managers events-from-db)]
           (let [result (command! cmd2)]
             (when (:errors result)
               (if *fail-on-process-manager-errors*
                 (assert false
                         (pr-str {:cmd cmd2 :result result :parent-cmd cmd}))
                 (log/error "process manager command failed"
-                           (pr-str {:cmd cmd2 :result result :parent-cmd cmd}))))))))
-    result))
+                           (pr-str {:cmd cmd2 :result result :parent-cmd cmd}))))))
+        (assoc result :events events-from-db)) ; replace with events with id
+      result)))

src/clj/rems/db/events.clj

@@ -1,5 +1,6 @@
 (ns rems.db.events
   (:require [rems.application.events :as events]
+            [rems.config :refer [env]]
             [rems.db.core :as db]
             [rems.json :as json]
             [rems.schema-base :as schema-base]
@@ -41,7 +42,7 @@
   (fix-event-from-db (db/get-latest-application-event {})))
 
 (defn add-event!
-  "Add event to database. Returns the event as it went into the db."
+  "Add `event` to database. Returns the event as it went into the db."
   [event]
   (fix-event-from-db (db/add-application-event! {:application (:application/id event)
                                                  :eventdata (event->json event)})))
@@ -51,9 +52,44 @@
   [event]
   (let [old-event (fix-event-from-db (first (db/get-application-event {:id (:event/id event)})))
         _ (assert old-event)
-        event (-> old-event
-                  (merge event)
-                  (dissoc :event/id))]
-    (fix-event-from-db (db/update-application-event! {:id (:event/id old-event)
-                                                      :application (:application/id event)
-                                                      :eventdata (event->json event)}))))
+        event (merge old-event event)]
+    (db/update-application-event! {:id (:event/id old-event)
+                                   :application (:application/id event)
+                                   :eventdata (event->json (dissoc event :event/id))})
+    event))
+
+(defn replace-event!
+  "Replaces an event on top of an old one.
+
+  Differs from `add-event!` in that it replaces an old event.
+  Differs from `update-event!` in that the event id is a new one.
+
+  Returns the event as it went into the db."
+  [event]
+  (let [old-event (fix-event-from-db (first (db/get-application-event {:id (:event/id event)})))
+        _ (assert old-event)
+        event (merge old-event event)]
+    (fix-event-from-db (db/replace-application-event! {:id (:event/id old-event)
+                                                       :application (:application/id event)
+                                                       :eventdata (event->json (dissoc event :event/id))}))))
+
+(defn add-event-with-compaction!
+  "Add `event` to database.
+
+  Consecutive `:draft-saved` events of `application` are compacted into one by replacing
+  the last event of `application` instead of creating a new one.
+
+  Returns the event as it went into the db."
+  [application event]
+  (let [last-event (-> application
+                       :application/events
+                       last)]
+    (if (and (:enable-save-compaction env)
+             (= :application.event/draft-saved
+                (:event/type event)
+                (:event/type last-event))
+             (= (:application/id event)
+                (:application/id last-event)))
+      (replace-event! (merge event
+                             (select-keys last-event [:event/id])))
+      (add-event! event))))

test/clj/rems/api/test_applications.clj

@@ -6,17 +6,19 @@
             [rems.api.services.attachment :as attachment]
             [rems.api.services.catalogue :as catalogue]
             [rems.api.testing :refer :all]
+            [rems.config]
             [rems.db.applications]
             [rems.db.blacklist :as blacklist]
             [rems.db.core :as db]
             [rems.db.test-data :as test-data]
             [rems.db.test-data-helpers :as test-helpers]
             [rems.handler :refer [handler]]
             [rems.json]
-            [rems.testing-util :refer [with-user]]
+            [rems.testing-util :refer [with-fixed-time with-user]]
             [ring.mock.request :refer :all])
   (:import java.io.ByteArrayOutputStream
-           java.util.zip.ZipInputStream))
+           java.util.zip.ZipInputStream
+           [org.joda.time DateTime DateTimeUtils DateTimeZone]))
 
 (use-fixtures
   :each
@@ -516,6 +518,93 @@
           (is (not= application-id (:application-id result))
               "should create a new application"))))))
 
+(deftest test-save-draft-compaction
+  (let [user-id "alice"
+        handler-id "handler"
+        form-id (test-helpers/create-form! {:form/fields [{:field/id "field"
+                                                           :field/type :text
+                                                           :field/title {:en "f" :fi "f" :sv "f"}
+                                                           :field/optional false}]})
+        workflow-id (test-helpers/create-workflow! {:type :workflow/master
+                                                    :handlers [handler-id]})
+        cat-item-id (test-helpers/create-catalogue-item! {:form-id form-id
+                                                          :workflow-id workflow-id})
+        application-id (test-helpers/create-application! {:catalogue-item-ids [cat-item-id]
+                                                          :actor user-id})]
+
+    (with-redefs [rems.config/env (assoc rems.config/env
+                                         :enable-save-compaction true)]
+      (testing "save draft"
+        (with-fixed-time (time/date-time 2022 1 1)
+          (fn []
+
+            (is (= {:success true}
+                   (send-command user-id
+                                 {:type :application.command/save-draft
+                                  :application-id application-id
+                                  :field-values [{:form form-id
+                                                  :field "field"
+                                                  :value "1"}]}))))))
+
+      (testing "application has one save event"
+        (let [application (get-application-for-user application-id user-id)]
+          (is (= ["application.event/created"
+                  "application.event/draft-saved"]
+                 (map :event/type (get application :application/events))))
+
+          (is (= {:event/actor "alice"
+                  :event/time "2022-01-01T00:00:00.000Z"
+                  :application/field-values [{:form form-id :field "field" :value "1"}]
+                  :event/type "application.event/draft-saved"}
+                 (-> application
+                     :application/events
+                     last
+                     (select-keys [:event/actor :event/time :application/field-values :event/type]))))
+
+          (is (= [{:field/id "field" :field/value "1"}]
+                 (->> application
+                      :application/forms
+                      (mapcat :form/fields)
+                      (map #(select-keys % [:field/id :field/value])))))))
+
+      (testing "save draft again"
+        (with-fixed-time (time/date-time 2022 1 2)
+          (fn []
+            (is (= {:success true}
+                   (send-command user-id
+                                 {:type :application.command/save-draft
+                                  :application-id application-id
+                                  :field-values [{:form form-id
+                                                  :field "field"
+                                                  :value "2"}]}))))))
+
+      (testing "application still has one save event"
+        (let [application (get-application-for-user application-id user-id)]
+          (is (= ["application.event/created"
+                  "application.event/draft-saved"]
+                 (map :event/type (get application :application/events))))
+
+          (is (= {:event/actor "alice"
+                  :event/time "2022-01-02T00:00:00.000Z"
+                  :application/field-values [{:form form-id :field "field" :value "2"}]
+                  :event/type "application.event/draft-saved"}
+                 (-> application
+                     :application/events
+                     last
+                     (select-keys [:event/actor :event/time :application/field-values :event/type]))))
+
+          (is (= [{:field/id "field" :field/value "2"}]
+                 (->> application
+                      :application/forms
+                      (mapcat :form/fields)
+                      (map #(select-keys % [:field/id :field/value])))))))
+
+      (testing "submit works"
+        (is (= {:success true}
+               (send-command user-id
+                             {:type :application.command/submit
+                              :application-id application-id})))))))
+
 (deftest test-approve-with-end
   (let [api-key "42"
         applicant "alice"

test/clj/rems/application/test_commands.clj

@@ -3,7 +3,6 @@
             [rems.application.commands :as commands]
             [rems.application.events :as events]
             [rems.application.model :as model]
-            [rems.form-validation :as form-validation]
             [rems.permissions :as permissions]
             [rems.util :refer [assert-ex getx]]
             [rems.testing-util :refer [with-fixed-time]]