Repository: CSCfi/rems (clojure)

Issue:
UI should remember the user's language preference (LBR)
From LBR: "It seems that the interface doesn't remember the user's language preference. At least I've had to switch each time I've logged in."

Pull request:
Closes #1381

Patch:
diff --git a/resources/migrations/20190722195700-user_settings.down.sql b/resources/migrations/20190722195700-user_settings.down.sql
new file mode 100644
index 0000000000..8cfa6c730f
--- /dev/null
+++ b/resources/migrations/20190722195700-user_settings.down.sql
@@ -0,0 +1,1 @@
+DROP TABLE IF EXISTS user_settings;
diff --git a/resources/migrations/20190722195700-user_settings.up.sql b/resources/migrations/20190722195700-user_settings.up.sql
new file mode 100644
index 0000000000..fdb0ef5e9d
--- /dev/null
+++ b/resources/migrations/20190722195700-user_settings.up.sql
@@ -0,0 +1,5 @@
+CREATE TABLE user_settings (
+  userId varchar(255) NOT NULL PRIMARY KEY,
+  settings jsonb,
+  FOREIGN KEY (userId) REFERENCES users
+);
diff --git a/resources/sql/queries.sql b/resources/sql/queries.sql
index 3876d0c56f..e6ff0437df 100644
--- a/resources/sql/queries.sql
+++ b/resources/sql/queries.sql
@@ -670,6 +670,12 @@ VALUES (:user, :userattrs::jsonb)
 ON CONFLICT (userId)
 DO UPDATE SET userAttrs = :userattrs::jsonb;
 
+-- :name update-user-settings! :!
+INSERT INTO user_settings (userId, settings)
+VALUES (:user, :settings::jsonb)
+ON CONFLICT (userId)
+DO UPDATE SET settings = :settings::jsonb;
+
 -- :name get-users :? :*
 SELECT userId
 FROM users;
@@ -684,6 +690,11 @@ SELECT userAttrs::TEXT
 FROM users
 WHERE userId = :user;
 
+-- :name get-user-settings :? :1
+SELECT settings::TEXT
+from user_settings
+where userId = :user;
+
 -- :name get-application-events :? :*
 SELECT id, appId, userId, round, event, comment, eventData::TEXT, time
 FROM application_event
diff --git a/src/clj/rems/api.clj b/src/clj/rems/api.clj
index 115d9b0311..e604f52967 100644
--- a/src/clj/rems/api.clj
+++ b/src/clj/rems/api.clj
@@ -13,6 +13,7 @@
             [rems.api.licenses :refer [licenses-api]]
             [rems.api.public :as public]
             [rems.api.resources :refer [resources-api]]
+            [rems.api.user-settings :refer [user-settings-api]]
             [rems.api.users :refer [users-api]]
             [rems.api.workflows :refer [workflows-api]]
             [rems.json :refer [muuntaja]]
@@ -113,5 +114,6 @@
       forms-api
       licenses-api
       resources-api
+      user-settings-api
       users-api
       workflows-api)))
diff --git a/src/clj/rems/api/user_settings.clj b/src/clj/rems/api/user_settings.clj
new file mode 100644
index 0000000000..c21a4baecc
--- /dev/null
+++ b/src/clj/rems/api/user_settings.clj
@@ -0,0 +1,27 @@
+(ns rems.api.user-settings
+  (:require [compojure.api.sweet :refer :all]
+            [rems.api.schema :refer :all]
+            [rems.db.user-settings :as user-settings]
+            [rems.util :refer [getx-user-id]]
+            [ring.util.http-response :refer :all]
+            [schema.core :as s]))
+
+(s/defschema UserSettings
+  {:language s/Keyword})
+
+(def user-settings-api
+  (context "/user-settings" []
+    :tags ["user-settings"]
+
+    (GET "/" []
+      :summary "Get user settings"
+      :roles #{:logged-in}
+      :return UserSettings
+      (ok (user-settings/get-user-settings (getx-user-id))))
+
+    (PUT "/" []
+      :summary "Update user settings"
+      :roles #{:logged-in}
+      :body [settings UserSettings]
+      :return SuccessResponse
+      (ok (user-settings/update-user-settings! (getx-user-id) settings)))))
diff --git a/src/clj/rems/db/user_settings.clj b/src/clj/rems/db/user_settings.clj
new file mode 100644
index 0000000000..5779cdc0e9
--- /dev/null
+++ b/src/clj/rems/db/user_settings.clj
@@ -0,0 +1,33 @@
+(ns rems.db.user-settings
+  (:require [rems.config :refer [env]]
+            [rems.db.core :as db]
+            [clojure.tools.logging :as log]
+            [rems.json :as json]))
+
+(defn- default-settings []
+  {:language (env :default-language)})
+
+(defn- parse-settings [settings]
+  (let [{:keys [language]} (json/parse-string settings)]
+    (merge {}
+           (when language {:language (keyword language)}))))
+
+(defn get-user-settings [user]
+  (merge (default-settings)
+         (parse-settings (:settings (db/get-user-settings {:user user})))))
+
+(defn- validate-settings [settings]
+  (let [{:keys [language]} settings]
+    (when (and language
+               (contains? (set (env :languages)) language))
+      settings)))
+
+(defn update-user-settings! [user new-settings]
+  (assert user "User missing!")
+  (let [old-settings (get-user-settings user)
+        validated (validate-settings new-settings)]
+    (db/update-user-settings!
+     {:user user
+      :settings (json/generate-string
+                 (merge old-settings validated))})
+    {:success (some? validated)}))
diff --git a/src/clj/rems/middleware.clj b/src/clj/rems/middleware.clj
index 5f477f36d8..89d3d5d39b 100644
--- a/src/clj/rems/middleware.clj
+++ b/src/clj/rems/middleware.clj
@@ -13,6 +13,7 @@
             [rems.db.api-key :as api-key]
             [rems.db.applications :as applications]
             [rems.db.roles :as roles]
+            [rems.db.user-settings :as user-settings]
             [rems.env :refer [+defaults+]]
             [rems.layout :refer [error-page]]
             [rems.locales :refer [tempura-config]]
@@ -138,8 +139,8 @@
   "Sets context/*lang*"
   [handler]
   (fn [request]
-    (binding [context/*lang* (or (get-in request [:params :lang])
-                                 (get-in request [:session :language])
+    (binding [context/*lang* (or (when context/*user*
+                                   (:language (user-settings/get-user-settings (getx-user-id))))
                                  (:default-language env))]
       (handler request))))
 
diff --git a/src/cljs/rems/config.cljs b/src/cljs/rems/config.cljs
index ebe8ae15cd..9837444273 100644
--- a/src/cljs/rems/config.cljs
+++ b/src/cljs/rems/config.cljs
@@ -7,7 +7,6 @@
  (fn [db [_ config]]
    (assoc db :config config
              :default-language (get config :default-language)
-             :language (get config :default-language)
              :languages (get config :languages))))
 
 (rf/reg-sub
diff --git a/src/cljs/rems/language.cljs b/src/cljs/rems/language.cljs
new file mode 100644
index 0000000000..af0f9b4fc4
--- /dev/null
+++ b/src/cljs/rems/language.cljs
@@ -0,0 +1,43 @@
+(ns rems.language
+  (:require [clojure.string :as str]
+            [re-frame.core :as rf :refer [reg-event-fx reg-sub]]))
+
+(reg-sub
+ :language
+ (fn [db _]
+   (or (get-in db [:user-settings :language])
+       (:language db)
+       (:default-language db))))
+
+(reg-sub
+ :languages
+ (fn [db _]
+   ;; default language first
+   (sort (comp not= (:default-language db))
+         (:languages db))))
+
+(reg-sub
+ :default-language
+ (fn [db _]
+   (:default-language db)))
+
+(reg-event-fx
+ ::set-language
+ (fn [{:keys [db]} [_ language]]
+   (let [user-id (get-in db [:identity :user :eppn])]
+     (if user-id
+       (rf/dispatch [:rems.user-settings/update-user-settings user-id {:language language}])
+       (do (update-language language)
+           {:db (assoc db :language language)})))))
+
+(defn- update-css [language]
+  (let [localized-css (str "/css/" (name language) "/screen.css")]
+    ;; Figwheel replaces the linked stylesheet
+    ;; so we need to search dynamically
+    (doseq [element (array-seq (.getElementsByTagName js/document "link"))]
+      (when (str/includes? (.-href element) "screen.css")
+        (set! (.-href element) localized-css)))))
+
+(defn update-language [language]
+  (set! (.. js/document -documentElement -lang) (name language))
+  (update-css language))
diff --git a/src/cljs/rems/language_switcher.cljs b/src/cljs/rems/language_switcher.cljs
index 0145c33a32..c3d2c5e7f0 100644
--- a/src/cljs/rems/language_switcher.cljs
+++ b/src/cljs/rems/language_switcher.cljs
@@ -1,7 +1,8 @@
 (ns rems.language-switcher
   (:require [clojure.string :as str]
-            [re-frame.core :as rf]
-            [rems.guide-functions])
+            [re-frame.core :as rf :refer [reg-event-fx reg-event-db]]
+            [rems.guide-functions]
+            [rems.status-modal :as status-modal])
   (:require-macros [rems.guide-macros :refer [component-info example]]))
 
 (defn lang-link-classes [current-language language]
@@ -22,7 +23,7 @@
                  [:button {:type :button
                            :class (lang-link-classes current-language language)
                            :on-click (fn []
-                                       (rf/dispatch [:set-current-language language])
+                                       (rf/dispatch [:rems.language/set-language language])
                                        (rf/dispatch [:rems.spa/user-triggered-navigation]))}
                   lang-str]]))))))
 
diff --git a/src/cljs/rems/spa.cljs b/src/cljs/rems/spa.cljs
index 1239958db3..2c58a4b5c2 100644
--- a/src/cljs/rems/spa.cljs
+++ b/src/cljs/rems/spa.cljs
@@ -38,6 +38,7 @@
             [rems.roles :as roles]
             [rems.status-modal :as status-modal]
             [rems.text :refer [text]]
+            [rems.user-settings :refer [fetch-user-settings!]]
             [rems.util :refer [dispatch! fetch parse-int]]
             [secretary.core :as secretary])
   (:require-macros [rems.read-gitlog :refer [read-current-version]])
@@ -61,23 +62,6 @@
  (fn [db _]
    (:translations db)))
 
-(reg-sub
- :language
- (fn [db _]
-   (:language db)))
-
-(reg-sub
- :languages
- (fn [db _]
-   ;; default language first
-   (sort (comp not= (:default-language db))
-         (:languages db))))
-
-(reg-sub
- :default-language
- (fn [db _]
-   (:default-language db)))
-
 ;; TODO: possibly move theme out
 (reg-sub
  :theme
@@ -90,7 +74,6 @@
  :initialize-db
  (fn [_ _]
    {:page :home
-    :language :en
     :languages [:en]
     :default-language :en
     :translations {}
@@ -116,23 +99,6 @@
  (fn [db [_ theme]]
    (assoc db :theme theme)))
 
-(reg-event-fx
- :set-current-language
- (fn [{:keys [db]} [_ language]]
-   {:db (assoc db :language language)
-    :update-document-language (name language)}))
-
-(reg-fx
- :update-document-language
- (fn [language]
-   (let [localized-css (str "/css/" (name language) "/screen.css")]
-     (set! (.. js/document -documentElement -lang) language)
-     ;; Figwheel replaces the linked stylesheet
-     ;; so we need to search dynamically
-     (doseq [element (array-seq (.getElementsByTagName js/document "link"))]
-       (when (str/includes? (.-href element) "screen.css")
-         (set! (.-href element) localized-css))))))
-
 (reg-event-fx
  :unauthorized!
  (fn [_ [_ current-url]]
@@ -181,15 +147,16 @@
 
 (defn home-page []
   (if @(rf/subscribe [:user])
-    ;; TODO this is a hack to show something useful on the home page
-    ;; when we are logged in. We can't really perform a dispatch!
-    ;; here, because that would be a race condition with #fragment
-    ;; handling in hook-history-navigation!
-    ;;
-    ;; One possibility is to have a separate :init default page that
-    ;; does the navigation/redirect logic, instead of using :home as
-    ;; the default.
     (do
+      (fetch-user-settings!)
+      ;; TODO this is a hack to show something useful on the home page
+      ;; when we are logged in. We can't really perform a dispatch!
+      ;; here, because that would be a race condition with #fragment
+      ;; handling in hook-history-navigation!
+      ;;
+      ;; One possibility is to have a separate :init default page that
+      ;; does the navigation/redirect logic, instead of using :home as
+      ;; the default.
       (rf/dispatch [:rems.catalogue/enter-page])
       [catalogue-page])
     [:div
diff --git a/src/cljs/rems/user_settings.cljs b/src/cljs/rems/user_settings.cljs
new file mode 100644
index 0000000000..08e7b70f3c
--- /dev/null
+++ b/src/cljs/rems/user_settings.cljs
@@ -0,0 +1,22 @@
+(ns rems.user-settings
+  (:require [re-frame.core :as rf :refer [reg-event-fx reg-event-db]]
+            [rems.language :as language]
+            [rems.status-modal :as status-modal]
+            [rems.util :refer [fetch put!]]))
+
+(reg-event-fx
+ :loaded-user-settings
+ (fn [{:keys [db]} [_ user-settings]]
+   (language/update-language (:language user-settings))
+   {:db (assoc db :user-settings user-settings)}))
+
+(defn fetch-user-settings! []
+  (fetch "/api/user-settings" {:handler #(rf/dispatch [:loaded-user-settings %])}))
+
+(reg-event-fx
+ ::update-user-settings
+ (fn [{:keys [db]} [_ user-id settings]]
+   (put! "/api/user-settings"
+         {:params settings
+          :handler (fn [_] (fetch-user-settings!))
+          :error-handler status-modal/common-error-handler!})))


Test patch:
diff --git a/test/clj/rems/api/test_user_settings.clj b/test/clj/rems/api/test_user_settings.clj
new file mode 100644
index 0000000000..b9c5aec9bc
--- /dev/null
+++ b/test/clj/rems/api/test_user_settings.clj
@@ -0,0 +1,40 @@
+(ns ^:integration rems.api.test-user-settings
+  (:require [clojure.test :refer :all]
+            [rems.db.user-settings :as user-settings]
+            [rems.db.users :as users]
+            [rems.handler :refer [handler]]
+            [rems.api.testing :refer :all]
+            [ring.mock.request :refer :all]))
+
+(def user-id "david")
+
+(def new-user
+  {:eppn user-id
+   :mail "d@av.id"
+   :commonName "David Newuser"})
+
+(def new-settings
+  {:language :fi})
+
+(use-fixtures
+  :once
+  api-fixture)
+
+(deftest user-settings-api-test
+  (-> (request :post "/api/users/create")
+      (json-body new-user)
+      (authenticate "42" "owner")
+      handler
+      assert-response-is-ok)
+  (testing "update user settings"
+    (-> (request :put "/api/user-settings")
+        (json-body new-settings)
+        (authenticate "42" user-id)
+        handler
+        assert-response-is-ok))
+  (testing "get user settings"
+    (let [body (-> (request :get "/api/user-settings")
+                   (authenticate "42" user-id)
+                   handler
+                   read-ok-body)]
+      (is (= body {:language "fi"})))))
diff --git a/test/clj/rems/db/test_user_settings.clj b/test/clj/rems/db/test_user_settings.clj
new file mode 100644
index 0000000000..2b57efab5e
--- /dev/null
+++ b/test/clj/rems/db/test_user_settings.clj
@@ -0,0 +1,45 @@
+(ns ^:integration rems.db.test-user-settings
+  (:require [clojure.test :refer :all]
+            [rems.db.testing :refer [rollback-db-fixture test-db-fixture]]
+            [rems.db.user-settings :as user-settings]
+            [rems.db.users :as users]))
+
+(use-fixtures :once test-db-fixture)
+(use-fixtures :each rollback-db-fixture)
+
+(deftest test-user-settings
+  (users/add-user! "user1" {:eppn "user1"})
+  (users/add-user! "user2" {:eppn "user2"})
+
+  (testing "user settings have the default settings for a new user"
+    (is (= (user-settings/get-user-settings "user1")
+           {:language :en})))
+
+  (testing "add a user setting"
+    (user-settings/update-user-settings! "user1" {:language :en})
+    (is (= (user-settings/get-user-settings "user1")
+           {:language :en})))
+
+  (testing "modify a user setting"
+    (user-settings/update-user-settings! "user1" {:language :fi})
+    (is (= (user-settings/get-user-settings "user1")
+           {:language :fi})))
+
+  (testing "updating with empty settings does not change the setting"
+    (user-settings/update-user-settings! "user1" {})
+    (is (= (user-settings/get-user-settings "user1")
+           {:language :fi})))
+
+  (testing "updating with nil language does not change the setting"
+    (user-settings/update-user-settings! "user1" {:language nil})
+    (is (= (user-settings/get-user-settings "user1")
+           {:language :fi})))
+
+  (testing "updating with undefined language does not change the setting"
+    (user-settings/update-user-settings! "user1" {:language :de})
+    (is (= (user-settings/get-user-settings "user1")
+           {:language :fi})))
+
+  (testing "modifying a setting does not change setting for an unrelated user"
+    (is (= (user-settings/get-user-settings "user2")
+           {:language :en}))))