Repository: CSCfi/rems
Pull request #3063 (2022-10-12 14:34:53)

Generate REMS layer architecture documentation
Initial work for #3017.

Code to generate REMS layer architecture documentation.

Work in progress. Run `graph` manually. NB: requires `graphviz` and `clj-kondo`to be installed.

I think we could schedule some refactoring work first and then come back to issue #3017. I'll add the ideas there.

# Checklist for author

Remove items that aren't applicable, check items that are done.

## Reviewability
- [x] Link to issue (#3017)

## Follow-up
- [x] New tasks are created for pending or remaining tasks (#3017)



Patch:
diff --git a/project.clj b/project.clj
index b19690200..7c027c8ab 100644
--- a/project.clj
+++ b/project.clj
@@ -119,7 +119,8 @@
                                 [etaoin "0.4.6"]
                                 [ring/ring-mock "0.4.0" :exclusions [cheshire]]
                                 [se.haleby/stub-http "0.2.12"]
-                                [com.icegreen/greenmail "1.6.7"]]
+                                [com.icegreen/greenmail "1.6.7"]
+                                [macroz/tangle "0.2.2"]]
 
                  :plugins [[lein-ancient "0.6.15"]]
 
diff --git a/src/cljs/rems/administration/organizations.cljs b/src/cljs/rems/administration/organizations.cljs
index 043212ec6..dfd5e2fe1 100644
--- a/src/cljs/rems/administration/organizations.cljs
+++ b/src/cljs/rems/administration/organizations.cljs
@@ -79,14 +79,10 @@
  ::organizations-table-rows
  (fn [_ _]
    [(rf/subscribe [::organizations])
-    (rf/subscribe [:language])
-    (rf/subscribe [:owned-organizations])])
- (fn [[organizations language owned-organizations] _]
-   (for [organization organizations
-         :let [id (:organization/id organization)
-               org-owner? (->> owned-organizations
-                               (some (comp #{id} :organization/id)))]]
-     {:key id
+    (rf/subscribe [:language])])
+ (fn [[organizations language] _]
+   (for [organization organizations]
+     {:key (:organization/id organization)
       :short-name {:value (get-in organization [:organization/short-name language])}
       :name {:value (get-in organization [:organization/name language])}
       :active (let [checked? (status-flags/active? organization)]
@@ -94,11 +90,10 @@
                       [readonly-checkbox {:value checked?}]]
                  :sort-value (if checked? 1 2)})
       :commands {:td [:td.commands
-                      [to-view-organization id]
-                      (when org-owner?
-                        [:<>
-                         [status-flags/enabled-toggle organization #(rf/dispatch [::set-organization-enabled %1 %2 [::fetch-organizations]])]
-                         [status-flags/archived-toggle organization #(rf/dispatch [::set-organization-archived %1 %2 [::fetch-organizations]])]])]}})))
+                      [to-view-organization (:organization/id organization)]
+                      [roles/show-when roles/+admin-write-roles+ ;; TODO doesn't match API roles exactly
+                       [status-flags/enabled-toggle organization #(rf/dispatch [::set-organization-enabled %1 %2 [::fetch-organizations]])]
+                       [status-flags/archived-toggle organization #(rf/dispatch [::set-organization-archived %1 %2 [::fetch-organizations]])]]]}})))
 
 (defn- organizations-list []
   (let [organizations-table {:id ::organizations


Test patch:
diff --git a/test/clj/rems/test_browser.clj b/test/clj/rems/test_browser.clj
index d771b469b..742c209de 100644
--- a/test/clj/rems/test_browser.clj
+++ b/test/clj/rems/test_browser.clj
@@ -2494,17 +2494,9 @@
 
     (btu/context-assoc! :organization-id (str "test-organizations org id " (btu/get-seed))
                         :organization-name (str "test-organizations org name " (btu/get-seed)))
-
-    (testing "view all organizations"
-      (go-to-admin "Organizations")
-      (is (every? #{"ViewDisableArchive"}
-                  (->> (slurp-table :organizations)
-                       (filter not-empty)
-                       (map #(get % "commands"))))
-          "owner can see all actions for all organizations"))
+    (create-organization)
 
     (testing "view after creation"
-      (create-organization)
       (is (btu/eventually-visible? :organization))
       (is (= {"Id" (btu/context-getx :organization-id)
               "Short name (FI)" "SNFI"
@@ -2660,14 +2652,7 @@
                     "Email" "review.email@example.com"
                     "Active" true}
                    (slurp-fields :organization)))
-            (is (not (btu/visible? :edit-organization)))
-
-            (go-to-admin "Organizations")
-            (is (= "View"
-                   (->> (slurp-table :organizations)
-                        (some #(when (= "SNEN" (get % "short-name"))
-                                 (get % "commands")))))
-                "organization actions should not be visible for non organization owner")))))))
+            (is (not (btu/visible? :edit-organization)))))))))
 
 (deftest test-small-navbar
   (testing "create a test application with the API to have another page to navigate to"
diff --git a/test/clj/rems/test_layers.clj b/test/clj/rems/test_layers.clj
new file mode 100644
index 000000000..410f30539
--- /dev/null
+++ b/test/clj/rems/test_layers.clj
@@ -0,0 +1,112 @@
+(ns rems.test-layers
+  "Test REMS layer architecture automatically.
+
+  Generates an architecture diagram.
+
+  NB: requires `graphviz` and `clj-kondo` to be installed on the machine.
+  NB: Work in progress. You should run `graph` manually currently."
+  (:require [clojure.java.io :as io]
+            [clojure.java.shell :as sh]
+            [clojure.edn :as edn]
+            [clojure.string :as str]
+            [clojure.tools.logging]
+            [clojure.test :refer [deftest is]]
+            [medley.core :refer [index-by]]
+            [tangle.core]))
+
+
+(defn interesting-ns? [s]
+  (and (str/starts-with? s "rems.")
+       (not (str/ends-with? s ".util"))
+       (not (str/starts-with? s "rems.api.schema"))
+       (not (str/starts-with? s "rems.service.dependencies"))
+       (or (str/starts-with? s "rems.ext.")
+           ;;(str/starts-with? s "rems.cli")
+           (str/starts-with? s "rems.db.")
+           (str/starts-with? s "rems.service.")
+           (str/starts-with? s "rems.api"))))
+
+(defn rename-ns [s]
+  ;; TODO implement these namespace renames
+  (-> s
+      (str/replace "rems.api.services" "rems.service")
+      (str/replace "rems.db.test-data" "rems.service.test-data")))
+
+(defn ok-transition? [from to]
+  (case [(:layer from) (:layer to)]
+    [:api :service] true
+    [:service :db] true
+    [:service :service] true
+    [:api :ext] true
+    [:service :ext] true
+    [:ext :ext] true
+    [:db :db] (= "rems.db.core" (:name to))
+    [:api :api] (= "rems.api" (:name from))
+    false))
+(defn analyze-code []
+  (let [ret (sh/sh "clj-kondo" "--lint" "src" "--parallel" "--config" "{:output {:format :edn} :analysis true}")
+        analysis (-> ret :out edn/read-string :analysis)
+        namespaces (->> analysis
+                        :namespace-definitions
+                        (mapv (comp str :name))
+                        ;;(concat ["rems.cli"]) ; consider implementing `rems.cli` ns
+                        (mapv rename-ns)
+                        (filter interesting-ns?)
+                        (mapv #(merge {:name %}
+                                      (cond (str/starts-with? % "rems.ext.") {:layer :ext}
+                                            (str/starts-with? % "rems.db.") {:layer :db}
+                                            (str/starts-with? % "rems.service.") {:layer :service}
+                                            (str/starts-with? % "rems.api") {:layer :api}))))
+
+        namespace-by-id (index-by :name namespaces)
+
+        namespace-usages (->> analysis
+                              :namespace-usages
+                              (map (juxt (comp str :from) (comp str :to)))
+                              distinct
+                              (map (fn [[from to]] [(rename-ns from) (rename-ns to)]))
+                              (filterv (fn [[from to]]
+                                         (and (interesting-ns? from)
+                                              (interesting-ns? to))))
+                              ;;(concat [["rems.cli" "rems.service.test-data"]])
+                              (map (fn [[from to]] [from to (when-not (ok-transition? (namespace-by-id from)
+                                                                                      (namespace-by-id to))
+                                                              {:color :red
+                                                               :constraint false
+                                                               :weight 0.01})])))]
+    {:namespace-usages namespace-usages
+     :namespaces namespaces}))
+
+(defn graph []
+  (let [{nodes :namespaces edges :namespace-usages} (analyze-code)
+        dot (tangle.core/graph->dot nodes edges {:directed? true
+                                                 :graph {:rankdir :LR
+                                                         :ranksep 3.5
+                                                         :rank :min
+                                                         :dpi 150
+                                                         :layout :dot}
+                                                 :edge {:penwidth 2}
+                                                 :node {:shape :box}
+                                                 :node->id :name
+                                                 :node->descriptor (fn [node]
+                                                                     (when-let [layer (:layer node)]
+                                                                       (case layer
+                                                                         :api {:style :filled
+                                                                               :fontcolor :white
+                                                                               :fillcolor "red"}
+                                                                         :service {:style :filled
+                                                                                   :fillcolor "#00ff00"}
+                                                                         :db {:style :filled
+                                                                              :fontcolor :white
+                                                                              :fillcolor "blue"}
+                                                                         :ext {:style :filled
+                                                                               :fillcolor "cyan"})))})]
+    (clojure.java.io/copy dot (clojure.java.io/file "docs/rems-layers.dot"))
+    (clojure.java.io/copy (tangle.core/dot->svg dot) (clojure.java.io/file "docs/rems-layers.svg"))
+    (clojure.java.io/copy (tangle.core/dot->image dot "png") (clojure.java.io/file "docs/rems-layers.png"))))
+
+(comment
+  (graph))
+
+(deftest test-architecture-layers
+  (is true)) ; TODO implement as test