add assertion

.alfred/job.sh

@@ -0,0 +1,8 @@
+#!/bin/bash
+
+if lein test; then
+  echo "testing successul";
+else
+  echo "tests failed";
+  sendmail -s "wanijo build failed" mail@joshavg.de < $ALFRED_LOG_FILE;
+fi;

.gitignore

@@ -16,5 +16,6 @@ neo4j/*
 resources/public/js/out
 .rebel_readline_history
 /elm-stuff
+.lsp
 *.*~
 *#*

README.md

@@ -16,16 +16,16 @@ You'll need:
 
 - start a neo4j database with `lein neo4j`
 - start a repl with `lein repl` or similar
-- import `wanijo.infrastructure.repl`
+- import `wanijo.infra.repl`
   - if you use leiningen for launching the repl, this will be your init-ns
-- run `wanijo.infrastructure.repl/create-user!` using the desired username and password as parameters to create an application user
+- run `wanijo.infra.repl/create-user!` using the desired username and password as parameters to create an application user
-- run `wanijo.infrastructure.repl/run-migrations!` to create desireable database constraints and structures
+- run `wanijo.infra.repl/run-migrations!` to create desireable database constraints and structures
 
 ### Launch the application server
 
 - start a repl
-- import `wanijo.infrastructure.repl`
+- import `wanijo.infra.repl`
-- run `wanijo.infrastructure.repl/dev-server!`
+- run `wanijo.infra.repl/dev-server!`
   - the application is available on port `8080`
 
 ## Launch as a standalone
@@ -54,4 +54,4 @@ The first level of structure are the building blocks of the domain, e.g. `instan
 
 `wanijo.handler` collects all routes and passes them to ring.
 
-`wanijo.infrastructure` contains the namespaces needed for technical code that do not belong to any domain, like database access, routing or similars.
+`wanijo.infra` contains the namespaces needed for technical code that do not belong to any domain, like database access, routing or similars.

project.clj

@@ -1,4 +1,4 @@
-(defproject wanijo "0.3.0"
+(defproject wanijo "0.3.1"
   :description "Graph Database via UI"
   :url "https://gitea.heevyis.ninja/josha/wanijo"
   :min-lein-version "2.9.0"
@@ -7,7 +7,7 @@
 
   :dependencies [;;clojure core
                  [org.clojure/clojure "1.10.1"]
-                 [nrepl "0.8.3"]
+                 [nrepl "1.0.0"]
 
                  ;; static site
                  [compojure "1.6.2"]
@@ -19,7 +19,7 @@
                                commons-codec]]
                  [ring/ring-json "0.5.0"]
                  [hiccup "1.0.5"]
-                 [joshavg/formulare "0.6.0"]
+                 ;[joshavg/formulare "0.6.0"]
 
                  ;; compojure uses old transitive dependencies of ring
                  ;; specifiy them here explicitly so newer versions
@@ -31,8 +31,14 @@
                  [gorillalabs/neo4j-clj "4.1.0"]
                  [org.neo4j.test/neo4j-harness "4.2.1"
                   :exclusions
-                  [com.fasterxml.jackson.core/jackson-core
+                  [org.eclipse.jetty/jetty-server
-                   commons-codec]]
+                   org.eclipse.jetty/jetty-http
+                   org.eclipse.jetty/jetty-io
+                   org.eclipse.jetty/jetty-util
+                   com.fasterxml.jackson.core/jackson-core
+                   jakarta.activation/jakarta.activation-api
+                   commons-codec
+                   commons-io]]
 
                  ;; additional server side libs
                  [buddy/buddy-hashers "1.7.0"
@@ -52,17 +58,21 @@
   :profiles {:dev {:plugins [;; web stuff
                              [lein-less "1.7.5"]
 
+                             [joshavg/lein-neo4j "0.5.0"]
+
                              ;; code quality
                              [lein-ancient "LATEST"]
                              [jonase/eastwood "LATEST"]
                              [lein-bikeshed "LATEST"]
                              [lein-cloverage "LATEST"]
-                             [lein-kibit "LATEST"]]}
+                             [lein-kibit "LATEST"]
+;                             [cider/cider-nrepl "0.26.0"]
+]}
              :uberjar {:aot :all
                        :main wanijo.main}}
 
   :neo4j {:path "neo4j"}
-  :repl-options {:init-ns wanijo.infrastructure.repl}
+  :repl-options {:init-ns wanijo.infra.repl}
   :less {:source-paths ["resources/app/stylesheets"]
          :target-path "resources/public/css"}
   :aliases {"uberjar" ["do" ["less" "once"] "uberjar"]}

resources/app/stylesheets/app.less

@@ -106,20 +106,18 @@ img, svg {
         display: grid;
         grid-template-columns: 40% 60%;
         align-items: center;
-        margin-top: 0;
+        margin: 0 @element-margin;
-        background-color: ThreeDShadow;
         //noinspection CssUnknownTarget
         background-image: url("/img/logo-full-flipped.svg");
         background-size: contain;
         background-position: right;
         background-origin: content-box;
         background-repeat: no-repeat;
-        border-bottom: 1px solid @ci-highlight;
+        border-bottom: 1px solid @ci-color;
 
         .app-title {
             grid-column: 1;
             font-size: 1.5rem;
-        }
 
             .app-title__hello {
 		font-size: 1rem;
@@ -127,21 +125,25 @@ img, svg {
 		font-weight: normal;
 		font-style: italic;
             }
+        }
+
 
         .header-content {
             grid-column: 2;
-        }
 
             .header-content__link {
 		display: inline-block;
 		margin-right: @accent-border-width;
             }
         }
+    }
 
     nav {
         grid-area: nav;
-        background-color: Window;
+        padding-right: @element-margin;
-        padding-right: 0;
+        border-right: 1px solid @ci-color;
+        margin-top: @element-margin;
+        margin-left: @element-margin;
 
         h2::before {
             content: "▤ ";
@@ -387,3 +389,21 @@ table {
     border: 1px solid @ci-highlight;
     height: 45rem;
 }
+
+@media (max-width: 768px) {
+
+    .grid {
+	grid-template-columns: auto;
+	grid-template-areas: "header" "nav" "main" "footer";
+
+	header {
+	    grid-template-columns: auto;
+
+	    .header-content {
+		grid-column: 1;
+		text-align: center;
+	    }
+	}
+    }
+
+}

resources/app/stylesheets/devmode.less

@@ -1,24 +0,0 @@
-.devbar {
-    position: fixed;
-    bottom: 0;
-    left: 0;
-    width: 100%;
-    font-family: monospace;
-    background-color: #ccc;
-
-    ol {
-        list-style-type: none;
-        padding: 0;
-        margin: 0;
-
-        li {
-            padding: .5rem;
-            border: 1px solid black;
-            margin: .5rem;
-
-            pre {
-                margin: 0;
-            }
-        }
-    }
-}

resources/public/css/devmode.css

@@ -1,21 +0,0 @@
-.devbar {
-  position: fixed;
-  bottom: 0;
-  left: 0;
-  width: 100%;
-  font-family: monospace;
-  background-color: #ccc;
-}
-.devbar ol {
-  list-style-type: none;
-  padding: 0;
-  margin: 0;
-}
-.devbar ol li {
-  padding: .5rem;
-  border: 1px solid black;
-  margin: .5rem;
-}
-.devbar ol li pre {
-  margin: 0;
-}

src/formulare/core.clj

@@ -0,0 +1,168 @@
+(ns formulare.core
+  (:require [formulare.theme :as theme]
+            [clojure.spec.alpha :as spec]
+            [clojure.spec.test.alpha :as spectest]
+            [hiccup
+             [form :as hform]
+             [core :as hcore]]
+            [ring.util.anti-forgery :refer [anti-forgery-field]]))
+
+(spec/def ::label string?)
+(spec/def ::required boolean?)
+(spec/def ::spec
+  (spec/or :registered-spec keyword?
+           :predicate ifn?))
+(spec/def ::options
+  (spec/or :empty empty?
+           :options (spec/coll-of (spec/tuple string? string?))))
+(spec/def ::widget
+  #{:input :select :checkbox :textarea :mselect :hidden :file})
+(spec/def ::from-req ifn?)
+(spec/def ::to-form ::from-req)
+(spec/def ::attrs (spec/map-of keyword? (fn [_] true)))
+(spec/def ::field
+  (spec/keys :opt-un [::label
+                      ::options
+                      ::widget
+                      ::from-req
+                      ::to-form
+                      ::required
+                      ::spec
+                      ::attrs]))
+(spec/def ::fields
+  (spec/map-of keyword? ::field))
+(spec/def ::form-specs
+  (spec/coll-of ::spec))
+(spec/def ::form
+  (spec/keys :req-un [::fields]
+             :opt-un [::form-specs]))
+
+(defn form-data [form-def req]
+  (reduce (fn [coll [id field]]
+            (let [value (get-in req [:params id])]
+              (assoc coll
+                     id
+                     (if-let [from-req (:from-req field)]
+                       (from-req value)
+                       value))))
+          {}
+          (:fields form-def)))
+
+(spec/fdef form-data
+           :args (spec/cat :form-def ::form :req map?)
+           :ret map?)
+(spectest/instrument `form-data)
+
+(defn form-specs-valid? [form-def req]
+  (reduce (fn [valid? form-spec]
+            (if (spec/valid? form-spec req)
+              true
+              (reduced false)))
+          true
+          (:form-specs form-def)))
+
+(defn field-specs-valid? [form-def req]
+  (reduce-kv
+    (fn [result field field-def]
+      (if-let [field-spec (:spec field-def)]
+        (if (spec/valid? field-spec (get-in req [:params field]))
+          true
+          (reduced false))
+        result))
+    true
+    (:fields form-def)))
+
+(defn valid? [form-def req]
+  (let [data (form-data form-def req)]
+    (and (field-specs-valid? form-def req)
+         (form-specs-valid? form-def req))))
+
+(spec/fdef valid?
+           :args (spec/cat :form-def ::form :req map?)
+           :ret map?)
+(spectest/instrument `valid?)
+
+(def ^:dynamic *row-theme* theme/row)
+(def ^:dynamic *widget-error-theme* theme/widget-error)
+(def ^:dynamic *form-error-theme* theme/form-error)
+(def ^:dynamic *label-theme* theme/label)
+(def ^:dynamic *input-widget-theme* theme/input-widget)
+(def ^:dynamic *checkbox-widget-theme* theme/checkbox-widget)
+(def ^:dynamic *textarea-widget-theme* theme/textarea-widget)
+(def ^:dynamic *select-widget-theme* theme/select-widget)
+(def ^:dynamic *mselect-widget-theme* theme/multiselect-widget)
+(def ^:dynamic *hidden-widget-theme* theme/hidden-widget)
+(def ^:dynamic *file-widget-theme* theme/file-widget)
+
+(defn widget-markup [values req validate? [id def]]
+  (let [{:keys [spec widget to-form]} def
+        value ((or to-form identity) (id values))
+        req-value (get-in req [:params id])
+        renderer (case widget
+                   :checkbox *checkbox-widget-theme*
+                   :textarea *textarea-widget-theme*
+                   :select *select-widget-theme*
+                   :mselect *mselect-widget-theme*
+                   :hidden *hidden-widget-theme*
+                   :file *file-widget-theme*
+                   *input-widget-theme*)]
+    (*row-theme* (when (and validate?
+                            spec
+                            (not (spec/valid? spec req-value)))
+                   (*widget-error-theme* id def req-value))
+                 (*label-theme* id def)
+                 (renderer id def (if validate? req-value value)))))
+
+(defn form-hash [form-def values]
+  (str (hash [form-def values])))
+
+(defn validate? [form-def values req]
+  (= (form-hash form-def values)
+     (get-in req [:params :__form-hash])))
+
+(defn render-widgets
+  ([form-def values req]
+   (render-widgets form-def values req
+                   {:render-anti-forgery-field? true}))
+  ([form-def values req {raff? :render-anti-forgery-field?}]
+   (let [validate? (validate? form-def values req)
+         form-errors (when (and validate?
+                                (not (form-specs-valid? form-def
+                                                        req)))
+                       (*form-error-theme* form-def req))
+         widget-mapper (partial widget-markup values req validate?)
+         defined-widgets (map widget-mapper (:fields form-def))
+         hash-field (hform/hidden-field "__form-hash"
+                                        (form-hash form-def values))
+         all-widgets (conj defined-widgets
+                           hash-field)
+         all-widgets (if raff?
+                       (conj all-widgets (anti-forgery-field))
+                       all-widgets)]
+     (if form-errors
+       (concat (if (sequential? form-errors)
+                 form-errors
+                 [form-errors])
+               all-widgets)
+       all-widgets))))
+
+(spec/def ::render-anti-forgery-field?
+  #(boolean? (boolean %)))
+
+(spec/def ::options-map
+  (spec/keys :req-un
+             [::render-anti-forgery-field?]))
+
+(spec/fdef render-widgets
+           :args (spec/or :three-params
+                          (spec/cat :form-def ::form
+                                    :values (spec/or :no-values nil?
+                                                     :values map?)
+                                    :req map?)
+                          :four-params
+                          (spec/cat :form-def ::form
+                                    :values (spec/or :no-values nil?
+                                                     :values map?)
+                                    :req map?
+                                    :options ::options-map)))
+(spectest/instrument `render-widgets)

src/formulare/theme.clj

@@ -0,0 +1,85 @@
+(ns formulare.theme
+  (:require [clojure.spec.alpha :as spec]
+            [hiccup
+             [form :as hform]
+             [core :as hcore]]))
+
+(defn row [& content] content)
+
+(defn err-msg [content]
+  [:section.flash--error
+   [:h2.flash__heading--error "Warning"]
+   content])
+
+(defn widget-error [id field-def field-value]
+  (err-msg
+   (map
+    (fn [prob]
+      [:p
+       "Field "
+       [:span.flash__field
+        (hcore/h (:label field-def))]
+       " must comply to "
+       [:span.flash__pred
+        (hcore/h (:pred prob))]])
+    (:clojure.spec.alpha/problems
+     (spec/explain-data (:spec field-def)
+                        field-value)))))
+
+(defn form-error [form-def req]
+  (for [prob (mapcat #(:clojure.spec.alpha/problems
+                       (spec/explain-data % req))
+                     (:form-specs form-def))]
+    (err-msg [:p "The form must comply to "
+              (hcore/h (:pred prob))])))
+
+(defn label [field-id field-def]
+  (when-not (= :hidden (:widget field-def))
+    (hform/label field-id (:label field-def))))
+
+(defn input-widget [id def value]
+  (hform/text-field (merge {:required (or (:required def) false)}
+                           (:attrs def))
+                    id
+                    value))
+
+(defn checkbox-widget [id def value]
+  (hform/check-box id
+                   (and (some? value)
+                        (not= 0 value))
+                   value))
+
+(defn textarea-widget [id def value]
+  (hform/text-area (merge {:required (or (:required def) false)}
+                          (:attrs def))
+                   id
+                   value))
+
+(defn select-widget [id def value]
+  (hform/drop-down id
+                   (:options def)
+                   value))
+
+(defn multiselect-widget [id def value]
+  [:select (merge {:multiple "multiple"
+                   :size (:size def 5)
+                   :name (name id)
+                   :id (name id)}
+                  (:attrs def))
+   (for [option (:options def)]
+     [:option {:value (second option)
+               :selected (some? (some (partial = (second option))
+                                      value))}
+      (hcore/h (first option))])])
+
+(comment
+  (multiselect-widget :id {:options [["<>" "key"]]} {}))
+
+(defn hidden-widget [id _ value]
+  (hform/hidden-field id value))
+
+(defn file-widget [id def value]
+  [:input {:type :file
+           :name id
+           :required (or (:required def) false)
+           :value value}])

src/wanijo/attribute/db.clj

@@ -1,5 +1,5 @@
 (ns wanijo.attribute.db
-  (:require [wanijo.infrastructure.neo4j :as neo4j]))
+  (:require [wanijo.infra.neo4j :as neo4j]))
 
 (neo4j/defquery findy-by-schema
   "MATCH (a:attribute)-->(s:schema)

src/wanijo/attribute/domain.clj

@@ -3,7 +3,7 @@
             [clojure.spec.alpha :as spec]))
 
 (def types
-  #{"string" "markdown"})
+  #{"string" "markdown" "file"})
 (spec/def ::type types)
 (spec/def ::name
   (spec/and ::specs/name (complement empty?)))

src/wanijo/attribute/routes.clj

@@ -3,7 +3,7 @@
             [clojure.pprint :refer [pprint]]
             [ring.util.response :as resp]
             [formulare.core :as form]
-            [wanijo.infrastructure.routing :refer [register! path]]
+            [wanijo.infra.routing :refer [register! path]]
             [wanijo.attribute.db :as domain]
             [wanijo.schema
              [routes :as schema-routes]

src/wanijo/handler.clj

@@ -1,5 +1,6 @@
 (ns wanijo.handler
-  (:require [compojure.core
+  (:require [clojure.string :refer [starts-with?]]
+            [compojure.core
              :refer [defroutes routes]]
             [compojure.route :as route]
             [ring.middleware.defaults
@@ -17,10 +18,11 @@
             [wanijo.instance.routes :as instance-routes]
             [wanijo.visualisation.routes :as vis-routes]
             [wanijo.tag.routes :as tag-routes]
-            [wanijo.infrastructure
+            [wanijo.infra
              [auth :as auth]
-             [devmode :as devmode]
+             [routing :refer [path]]
-             [routing :refer [path]]]))
+             [gzip :as gzip]
+             [neo4j :as neo4j]]))
 
 (defn- wrap-login-redirect [handler]
   (fn [req]
@@ -44,7 +46,8 @@
   (-> app-routes
       schema-middleware/wrap-user-schemas!
       ring-json/wrap-json-response
-      (wrap-defaults site-defaults)))
+      (wrap-defaults site-defaults)
+      gzip/wrap-gzip))
 
 (defn wrap-spec-asserts [handler]
   (fn [req]
@@ -54,11 +57,11 @@
 (def dev-app
   (-> app-routes
       wrap-spec-asserts
-      devmode/wrap-devmode
       schema-middleware/wrap-user-schemas!
       ring-json/wrap-json-response
       (wrap-defaults
        (assoc-in site-defaults
                  [:session :store]
                  (session-cookie/cookie-store
-                  {:key "1234567890123456"})))))
+                  {:key (subs (neo4j/uuid) 0 16)})))
+      gzip/wrap-gzip))

src/wanijo/home/routes.clj

@@ -1,6 +1,6 @@
 (ns wanijo.home.routes
   (:require [compojure.core :refer [defroutes GET]]
-            [wanijo.infrastructure.routing :refer [register!]]
+            [wanijo.infra.routing :refer [register!]]
             [wanijo.home.view :as home-view]))
 
 (defroutes routes

src/wanijo/home/view.clj

@@ -1,5 +1,5 @@
 (ns wanijo.home.view
-  (:require [wanijo.infrastructure.view :as view]))
+  (:require [wanijo.infra.view :as view]))
 
 (defn root! [req]
-  (view/layout :session (:session req)))
+  (view/layout :request req))

src/wanijo/infra/auth.clj

@@ -1,11 +1,11 @@
-(ns wanijo.infrastructure.auth
+(ns wanijo.infra.auth
   (:require [compojure.core :refer [POST GET defroutes]]
             [ring.util.response :refer [redirect]]
             [ring.util.anti-forgery :refer [anti-forgery-field]]
             [buddy.hashers :as hashers]
             [hiccup.form :as hform]
-            [wanijo.infrastructure.view :as view]
+            [wanijo.infra.view :as view]
-            [wanijo.infrastructure.routing :refer [register! path]]
+            [wanijo.infra.routing :refer [register! path]]
             [wanijo.user.db :as user-domain]))
 
 (defn- login-check! [req]

src/wanijo/infra/common.clj

@@ -1,4 +1,4 @@
-(ns wanijo.infrastructure.common)
+(ns wanijo.infra.common)
 
 (defn in? [coll x]
   (some? (some (partial = x) coll)))

src/wanijo/infra/gzip.clj

@@ -0,0 +1,77 @@
+(ns wanijo.infra.gzip
+  (:require [clojure.java.io :as io])
+  (:import (java.io InputStream
+                    Closeable
+                    File
+                    PipedInputStream
+                    PipedOutputStream)
+           (java.util.zip GZIPOutputStream)))
+
+(defn set-response-headers
+  [headers]
+  (if-let [vary (or (get headers "vary") (get headers "Vary"))]
+    (-> headers
+        (assoc "Vary" (str vary ", Accept-Encoding"))
+        (assoc "Content-Encoding" "gzip")
+        (dissoc "Content-Length" "content-length")
+        (dissoc "vary"))
+    (-> headers
+        (assoc "Vary" "Accept-Encoding")
+        (assoc "Content-Encoding" "gzip")
+        (dissoc "Content-Length" "content-length"))))
+
+(defn accepts-gzip?
+  [req]
+  (if-let [accepts (get-in req [:headers "accept-encoding"])]
+    ;; Be aggressive in supporting clients with mangled headers (due to
+    ;; proxies, av software, buggy browsers, etc...)
+    (re-seq
+      #"(gzip\s*,?\s*(gzip|deflate)?|X{4,13}|~{4,13}|\-{4,13})"
+      accepts)))
+
+(defn supported-response? [resp]
+  (let [{:keys [status headers body]} resp
+        min-bytes 859]
+    (and
+      ;; correct status code
+      (#{200 201 202 203 204 205 403 404} status)
+      ;; not already encoded
+      (not (or (headers "Content-Encoding")
+               (headers "content-encoding")))
+      ;; correct data type in body
+      (or (string? body)
+          (seq? body)
+          (instance? InputStream body)
+          (and (instance? File body)
+               (re-seq #"(?i)\.(htm|html|css|js|json|xml)"
+                       (pr-str body))))
+      ;; sensible body sizes
+      (cond (string? body) (> (count body) min-bytes)
+            (seq? body) (> (count body) min-bytes)
+            (instance? File body) (> (.length body) min-bytes)
+            :else true))))
+
+(defn compress-body [body]
+  (let [p-in (PipedInputStream.)
+        p-out (PipedOutputStream. p-in)]
+    (future
+      (with-open [out (GZIPOutputStream. p-out)]
+        (if (seq? body)
+          (doseq [string body] (io/copy (str string) out))
+          (io/copy body out)))
+      (when (instance? Closeable body)
+        (.close ^Closeable body)))
+    p-in))
+
+(defn gzip-response [resp]
+  (-> resp
+      (update :headers set-response-headers)
+      (update :body compress-body)))
+
+(defn wrap-gzip [handler]
+  (fn [req]
+    (let [resp (handler req)]
+      (if (and (accepts-gzip? req)
+               (supported-response? resp))
+        (gzip-response resp)
+        resp))))

src/wanijo/infra/neo4j.clj

@@ -1,11 +1,11 @@
-(ns wanijo.infrastructure.neo4j
+(ns wanijo.infra.neo4j
   (:require [neo4j-clj.core :as db]
             [neo4j-clj.in-memory :as db-inm]
-            [wanijo.infrastructure.devmode :as devmode]
             [clj-time.format :as time-format]
             [clj-time.local :as time-local]
             [clojure.spec.alpha :as spec]
-            [clojure.string :as cljs])
+            [clojure.string :as cljs]
+            [wanijo.infra.sysconfig :refer [env]])
   (:import (java.util UUID)
            (java.net URI)))
 
@@ -23,8 +23,7 @@
 
 (defn create-conn!
   ([]
-   (let [env #(or (System/getenv %1) %2)
+   (let [port (env "NEO4J_PORT" standard-port)
-         port (env "NEO4J_PORT" standard-port)
          host (env "NEO4J_HOST" standard-host)
          user (env "NEO4J_USER" standard-user)
          pass (env "NEO4J_PASS" standard-pass)]
@@ -35,8 +34,7 @@
     user
     pass)))
 
-(def conn
+(def conn (atom nil))
-  (atom nil))
 
 (defn reset-conn!
   ([]
@@ -47,13 +45,17 @@
 (defn in-memory-conn! []
   (reset! conn (db-inm/create-in-memory-connection)))
 
-(defmacro defquery [& args] `(db/defquery ~@args))
+(defonce query-strings (atom {}))
+(defmacro defquery [name query]
+  `(do (def ~name (db/create-query ~query))
+       (swap! wanijo.infra.neo4j/query-strings
+              assoc (hash ~name) ~query)))
 
 (defn uuid []
   (str (UUID/randomUUID)))
 
 (defn butiful-query [qry]
-  (->> qry
+  (->> (get @query-strings (hash qry) "unknown query")
        str
        cljs/trim-newline
        cljs/split-lines
@@ -61,13 +63,14 @@
        (filter #(pos? (count %)))
        (cljs/join \newline)))
 
+(def log-queries (= "true" (env "LOG_QUERIES" "false")))
+(comment (def log-queries true))
+
 (defn exec-query! [qry params]
   (let [live-conn (or @conn (reset-conn!))]
     (with-open [session (db/get-session live-conn)]
-      (devmode/send-to-bar
+      (when log-queries
-       (str (butiful-query qry)
+        (println (butiful-query qry) \newline params \newline))
-            "<br>---Params---<br>"
-            params))
       ;; neo4j-clj returns lazy lists, but when we leave with-open,
       ;; the ResultSet (?) is already closed, so the list cannot
       ;; be processed
@@ -84,10 +87,6 @@
     (doseq [tuple tuples]
       (let [qry (first tuple)
             params (second tuple)]
-        (devmode/send-to-bar
-         (str (butiful-query qry)
-              "<br>---Params---<br>"
-              params))
         (spec/assert map? params)
         (qry tx params)))))
 

src/wanijo/infra/repl.clj

@@ -1,7 +1,7 @@
-(ns wanijo.infrastructure.repl
+(ns wanijo.infra.repl
   (:require [buddy.hashers :as hashers]
             [wanijo.main :as main]
-            [wanijo.infrastructure.neo4j :as neo4j]))
+            [wanijo.infra.neo4j :as neo4j]))
 
 (neo4j/defquery create-user
   "CREATE (n:user)
@@ -88,10 +88,17 @@
 (defn init-version-2 []
   (neo4j/exec-query! migrate-links {}))
 
+(neo4j/defquery migrate-permissions
+  "MATCH (s:schema)-[:created_by]->(u:user)
+   MERGE (u)-[:permission {type:'write'}]->(s)")
+(defn init-version-3 []
+  (neo4j/exec-query! migrate-permissions {}))
+
 (def migrations
   [init-version-0
    init-version-1
-   init-version-2])
+   init-version-2
+   init-version-3])
 
 (defn run-migrations! []
   (neo4j/exec-query! init-config {:now (neo4j/now-str)})
@@ -118,6 +125,10 @@
   (neo4j/in-memory-conn!)
   (create-user! "admin" "admin"))
 
+(defn dev-env! []
+  (setup-in-memory!)
+  (dev-server!))
+
 (comment
   (dev-server!)
   (setup-in-memory!)

src/wanijo/infra/routing.clj

@@ -1,4 +1,4 @@
-(ns wanijo.infrastructure.routing
+(ns wanijo.infra.routing
   (:require [clojure.string :as string]))
 
 (def all-routes

src/wanijo/infra/sysconfig.clj

@@ -0,0 +1,7 @@
+(ns wanijo.infra.sysconfig)
+
+(defn env
+  ([name]
+   (System/getenv name))
+  ([name default]
+   (or (System/getenv name) default)))

src/wanijo/infra/time.clj

@@ -1,4 +1,4 @@
-(ns wanijo.infrastructure.time
+(ns wanijo.infra.time
   (:require [clj-time.format :as format]))
 
 (defn prettify-dt [date-str]

src/wanijo/infra/view.clj

@@ -1,8 +1,8 @@
-(ns wanijo.infrastructure.view
+(ns wanijo.infra.view
   (:require [hiccup
              [page :refer [html5 include-js include-css]]
              [core :refer [h]]]
-            [wanijo.infrastructure.routing :refer [path]]))
+            [wanijo.infra.routing :refer [path]]))
 
 (defn btnlink
   ([target caption]
@@ -35,8 +35,7 @@
            head nil}}]
   (let [session (or session (:session request))
         ident (:ident session)
-        authed? (some? ident)
+        authed? (some? ident)]
-        devmode? (:devmode session)]
     (html5
      [:head
       [:meta {:charset "utf-8"}]
@@ -44,7 +43,6 @@
               :content "width=device-width,initial-scale=1,shrink-to-fit=no"}]
       [:title (h (str (when title (str title " - ")) "wanijo"))]
       (include-css "/css/app.css")
-      (when devmode? (include-css "/css/devmode.css"))
       (include-js "/js/scripts.js")
       head]
      [:body

src/wanijo/infrastructure/devmode.clj

@@ -1,46 +0,0 @@
-(ns wanijo.infrastructure.devmode
-  (:require [hiccup.core :as hcore]
-            [clojure.string :as cljs]))
-
-(def bar-entries (atom []))
-
-(defn send-to-bar [msg]
-  (swap! bar-entries #(conj % msg)))
-
-(defn devmode-on? [req]
-  (let [query-param (get-in req [:query-params "dev"])
-        cookie (get-in req [:cookies "devmode" :value])]
-    (or (= query-param "on")
-        (and (= cookie "1")
-             (not= query-param "off")))))
-
-(defn devbar [resp]
-  (hcore/html
-   [:section.devbar
-    [:ol
-     (for [entry @bar-entries]
-       [:li [:pre entry]])]]))
-
-(defn append-devbar [resp]
-  (let [body (:body resp)
-        new-body (cljs/replace
-                  body "</body>" (str (devbar resp) "</body>"))]
-    (assoc resp :body new-body)))
-
-(defn wrap-devmode [handler]
-  (fn [req]
-    (let [on? (devmode-on? req)
-          query-param? (get-in req [:query-params "dev"])
-          new-req (assoc-in req [:session :devmode] on?)
-          resp (handler new-req)
-          new-resp (cond
-                     on? (-> resp
-                             append-devbar
-                             (assoc-in [:cookies :devmode] 1))
-                     (some? query-param?) (assoc-in
-                                           resp
-                                           [:cookies :devmode]
-                                           (if on? 1 0))
-                     :else resp)]
-      (reset! bar-entries [])
-      new-resp)))

src/wanijo/instance/db.clj

@@ -1,8 +1,9 @@
 (ns wanijo.instance.db
   (:require [clojure.spec.alpha :as spec]
-            [wanijo.infrastructure.neo4j :as neo4j]
+            [wanijo.infra.neo4j :as neo4j]
             [wanijo.instance.domain :as domain-instance]
-            [wanijo.tag.db :as db-tag]))
+            [wanijo.tag.db :as db-tag]
+            [wanijo.instance.revision.db :as db-rev]))
 
 (neo4j/defquery findy-by-schema
   "MATCH (i:instance)-[:of]->(s:schema)
@@ -125,14 +126,22 @@
              :instance_uuid (:uuid instance)
              :attribute_uuid (-> prop :attribute :uuid)}]))
        (:properties instance)))
-(defn edit! [instance]
+(defn edit! [instance revision]
   (let [prop-tuples (instance->prop-tuples instance)]
     (apply neo4j/exec-queries!
            (concat [[edit-instance
                      {:uuid (:uuid instance)
                       :name (:name instance)
                       :updated_at (neo4j/now-str)}]]
-                   prop-tuples))))
+                   prop-tuples
+                   (db-rev/revision-queries revision)))))
+
+(comment
+  (db-rev/revision-queries
+   {:instance-name "dings"
+    :instance-uuid "4711"
+    :properties [{:type "string"
+                  :value "dings-prop"}]}))
 
 (neo4j/defquery delete
   "MATCH (i:instance {uuid: $uuid}),
@@ -145,8 +154,13 @@
          (i)-[tw:tagged_with]->()
    OPTIONAL MATCH
          (i)-[l:link]-()
+   OPTIONAL MATCH
+         (i)<-[ric:of]-(rev:revision)
+   OPTIONAL MATCH
+         (rev_prop:rev_property)-[rpc:of]->(rev)
    DELETE pac, pc, cb, ic, p,
-          l, tw, i")
+          l, tw, i, ric,
+          rpc, rev_prop, rev")
 (defn delete! [uuid]
   (neo4j/exec-query! delete {:uuid uuid}))
 
@@ -242,3 +256,4 @@
                :starred_at (-> % :s :created_at))
        (neo4j/exec-query! starred-by-user
                           {:user_uuid user-uuid})))
+

src/wanijo/instance/domain.clj

@@ -66,3 +66,12 @@
 (spec/def ::full-instance
   (spec/merge ::instance-with-schema
               ::contains-full-information))
+
+(defn to-revision [instance]
+  {:instance-name (:name instance)
+   :instance-uuid (:uuid instance)
+   :properties
+    (map (fn [{:keys [attribute value]}]
+           {:value value
+            :type (:type attribute)})
+         (:properties instance))})

src/wanijo/instance/files.clj

@@ -0,0 +1,50 @@
+(ns wanijo.instance.files
+  (:require [clojure.java.io :as io]
+            [wanijo.infra.sysconfig :refer [env]]
+            [wanijo.infra.neo4j :refer [uuid]])
+  (:import [java.io File]))
+
+(def files-home (str (env "WANIJO_HOME") "/files"))
+
+(comment
+  (def files-home "/tmp/wanijo"))
+
+(defn persist-files! [instance]
+  (doall
+    (for [file (->> (:properties instance)
+                    (filter #(= "file" (-> % :attribute :type)))
+                    (map (fn [prop] {:file (:value prop)
+                                     :uuid (:uuid prop)})))
+          :let [uploaded-file (:file file)
+                size (:size uploaded-file)
+                uuid (if (empty? (:uuid file)) (uuid) (:uuid file))
+                path (str files-home "/" uuid)]
+          :when (> size 0)]
+      (do
+        (.mkdirs (io/file  files-home))
+        (io/copy (io/file (:tempfile uploaded-file)) (io/file path))
+        {:path path
+         :uuid uuid
+         :filename (:filename uploaded-file)
+         :content-type (:content-type uploaded-file)}))))
+
+(comment
+  (let [instance {:name "Frank",
+                  :properties
+                  '({:attribute
+                     {:name "Dateidings",
+                      :created_at "20210929T154103.152Z",
+                      :type "file",
+                      :uuid "00847b4c-9961-47cd-a64f-18eaea0e362f",
+                      :required 0},
+                     :value
+                     {:filename "2020.pdf",
+                      :content-type "application/pdf",
+                      :tempfile nil,
+                      :size 127785},
+                     :uuid "f7d56f9c-e74a-4b12-95c1-f33961672072"}),
+                  :uuid "def4dacb-979f-4a0d-b1d6-535ac2a3f94b"}]
+    (->> (:properties instance)
+         (filter #(= "file" 1 #_(-> % :attribute :type))) #_(map (fn [prop] {:file (:value prop)
+                                                                             :uuid (:uuid prop)}))))
+  )

src/wanijo/instance/forms.clj

@@ -34,6 +34,7 @@
 (defn attr-type->widget [attr-type]
   (case attr-type
     ("markdown" "text") :textarea
+    "file" :file
     :input))
 
 (defn attr->field-id [attr]

src/wanijo/instance/revision/db.clj

@@ -0,0 +1,33 @@
+(ns wanijo.instance.revision.db
+  (:require [wanijo.infra.neo4j :as neo4j]))
+
+(neo4j/defquery save-revision
+  "MATCH (i:instance)
+   WHERE i.uuid = $uuid
+   CREATE (r:revision)-[:of]->(i)
+     SET r.uuid = $rev_uuid,
+         r.instance_name = $name,
+         r.created_at = $now")
+(neo4j/defquery save-revision-property
+  "MATCH (r:revision)
+   WHERE r.uuid = $rev_uuid
+   CREATE (rp:rev_property)-[:of]->(r)
+     SET rp.uuid = $rp_uuid,
+         rp.value = $value,
+         rp.type = $type,
+         rp.created_at = $now")
+(defn revision-queries [revision]
+  (let [rev-uuid (neo4j/uuid)]
+    (concat [[save-revision
+              {:uuid (:instance-uuid revision)
+               :rev_uuid rev-uuid
+               :name (:instance-name revision)
+               :now (neo4j/now-str)}]]
+            (map (fn [{:keys [value type]}]
+                   [save-revision-property
+                    {:rev_uuid rev-uuid
+                     :rp_uuid (neo4j/uuid)
+                     :value value
+                     :type type
+                     :now (neo4j/now-str)}])
+                 (:properties revision)))))

src/wanijo/instance/routes.clj

@@ -1,6 +1,7 @@
 (ns wanijo.instance.routes
   (:require [compojure.core :refer [defroutes wrap-routes
-                                    GET POST DELETE]]
+                                    GET POST DELETE]
+             :as compojure]
             [ring.util.response :as resp]
             [formulare.core :as form]
             [wanijo.instance.view
@@ -10,18 +11,20 @@
              [link-selection :refer [link-selection]]
              [bulk-link-selection :refer [bulk-link-selection]]
              [starred :refer [starred]]]
-            [wanijo.instance.view.starred :refer [starred]]
+            [wanijo.instance
-            [wanijo.instance.db :as domain]
+             [db :as db]
-            [wanijo.instance.forms :as forms-inst]
+             [forms :as forms-inst]
+             [domain :as domain]
+             [files :as files]]
             [wanijo.schema.db :as domain-schema]
             [wanijo.schema.middleware :as middleware-schema]
             [wanijo.link.db :as domain-link]
-            [wanijo.infrastructure.routing :refer [register! path]]
+            [wanijo.infra.routing :refer [register! path]]
             [wanijo.attribute.db :as db-attr]))
 
 (defn route-list! [schema-uuid req]
   (instances (domain-schema/find-by-uuid! schema-uuid)
-             (domain/find-by-schema! schema-uuid)
+             (db/find-by-schema! schema-uuid)
              (forms-inst/with-attributes (db-attr/required! schema-uuid))
              req))
 
@@ -35,7 +38,7 @@
             req-attrs (db-attr/required! schema-uuid)
             instance (forms-inst/form-data->instance form-data
                                                      req-attrs)]
-        (domain/create! user-uuid
+        (db/create! user-uuid
                     schema-uuid
                     instance)
         (resp/redirect (path :instance-list
@@ -43,51 +46,53 @@
       (route-list! schema-uuid req))))
 
 (defn instance! [uuid]
-  (domain/full-instance-by-uuid! uuid))
+  (db/full-instance-by-uuid! uuid))
 
 (defn route-show! [uuid req]
   (let [user-uuid (-> req :session :uuid)
         instance (assoc (instance! uuid)
                         :starred
-                        (domain/is-starred! uuid
+                        (db/is-starred! uuid
                                         user-uuid))]
     (show instance
           (domain-schema/accessible-schemas! user-uuid)
           req)))
 
-(defn form! [attrs]
-  (forms-inst/with-attributes attrs))
-
 (defn route-edit-form! [uuid req]
   (let [instance (instance! uuid)
         attrs (db-attr/find-by-instance! uuid)
         user-uuid (get-in req [:session :uuid])]
     (edit instance
-          (form! attrs)
+          (forms-inst/with-attributes attrs)
           (forms-inst/instance->form-data instance)
           (domain-schema/accessible-schemas! user-uuid)
           req)))
 
+(comment
+  (forms-inst/with-attributes
+    (db-attr/find-by-instance!
+     "def4dacb-979f-4a0d-b1d6-535ac2a3f94b")))
+
 (defn route-edit! [uuid req]
   (let [attrs (db-attr/find-by-instance! uuid)
-        form-def (form! attrs)]
+        form-def (forms-inst/with-attributes attrs)]
     (if (form/valid? form-def req)
       (let [form-data (form/form-data form-def req)
             form-instance (forms-inst/form-data->instance form-data attrs)
             instance (assoc form-instance :uuid uuid)]
-        (domain/edit! instance)
+        (db/edit! instance (domain/to-revision instance))
         (resp/redirect (path :instance-show instance)))
       (route-show! uuid req))))
 
 (defn route-delete! [uuid]
   (let [schema (domain-schema/find-by-instance! uuid)]
-    (domain/delete! uuid)
+    (db/delete! uuid)
     (resp/redirect (path :instance-list
                          {:schema-uuid (:uuid schema)}))))
 
 (defn link-form! [schema-uuid]
   (forms-inst/link-form
-   (domain/find-by-schema! schema-uuid)))
+   (db/find-by-schema! schema-uuid)))
 
 (defn route-link-selection! [uuid schema-uuid req]
   (link-selection (instance! uuid)
@@ -106,33 +111,38 @@
         (resp/redirect (path :instance-edit-form {:uuid uuid})))
       (route-link-selection! uuid schema-uuid req))))
 
+(comment
+  (form/valid? (link-form! "6e7009e3-724b-4fce-afe0-7cf50f0bfcff")
+               {:params {:name "link-name"
+                         :instances ["4bb90cc3-54d1-4d7d-bc30-c357777613ef"]}}))
+
 (defn route-delete-link! [uuid link-uuid]
   (domain-link/delete! link-uuid)
   (resp/redirect (path :instance-edit-form {:uuid uuid})))
 
 (defn route-mark-starred! [uuid req]
-  (domain/mark-starred! uuid
+  (db/mark-starred! uuid
                     (-> req :session :uuid))
   (resp/redirect (path :instance-show {:uuid uuid})))
 
 (defn route-remove-starred! [uuid req]
-  (domain/remove-starred! uuid
+  (db/remove-starred! uuid
                       (-> req :session :uuid))
   (resp/redirect (path :instance-show {:uuid uuid})))
 
 (defn route-list-starred! [req]
   (starred
-   (domain/starred-by-user! (-> req :session :uuid))
+   (db/starred-by-user! (-> req :session :uuid))
    req))
 
 (defn route-bulk-link-selection! [uuid req]
   (let [user-uuid (-> req :session :uuid)]
-    (bulk-link-selection (domain/full-instance-by-uuid! uuid)
+    (bulk-link-selection (db/full-instance-by-uuid! uuid)
                          (->> (domain-schema/accessible-schemas!
                                user-uuid)
                               (map (fn [schema]
                                      {:schema schema
-                                      :instances (domain/find-by-schema!
+                                      :instances (db/find-by-schema!
                                                   (:uuid schema))})))
                          req)))
 
@@ -140,28 +150,44 @@
   (let [names (-> req :params :name)
         instances (-> req :params :instances)
         source-uuid (-> req :params :source-uuid)]
-;    (clojure.pprint/pprint names)
+                                        ;    (clojure.pprint/pprint names)
-;    (clojure.pprint/pprint instances)
+                                        ;    (clojure.pprint/pprint instances)
-;    (clojure.pprint/pprint source-uuid)
+                                        ;    (clojure.pprint/pprint source-uuid)
-#_    (clojure.pprint/pprint
+    #_(clojure.pprint/pprint
        (map (fn [[target-schema target-instances]]
               {:link-name (get names target-schema)
                :instances target-instances})
             instances)))
   (resp/redirect (path :instance-show {:uuid uuid})))
 
-(defroutes routes
+(defn schema-uuid-by-instance [req]
+  (-> (get-in req [:params :uuid])
+      (domain-schema/find-by-instance!)
+      :uuid))
+
+(defn schema-uuid-from-params [req]
+  (get-in req [:params :schema-uuid]))
+
+(def linking-routes
+  (-> (compojure/routes
+       (GET (register! :instance-link-selection
+                       "/instance/:uuid/link/:schema-uuid")
+         [uuid schema-uuid :as req]
+         (route-link-selection! uuid schema-uuid req))
+       (POST (register! :instance-link-create
+                        "/instance/:uuid/link/:schema-uuid")
+         [uuid schema-uuid :as req]
+         (route-create-link! uuid schema-uuid req)))
       (wrap-routes
-   (GET (register! :instance-list "/instance/list/:schema-uuid")
+       (middleware-schema/wrap-allowed-to-write!
-        [schema-uuid :as req]
-        (route-list! schema-uuid req))
-   (middleware-schema/wrap-allowed-to-read!
         #(get-in % [:params :schema-uuid])))
-  (POST (register! :instance-new "/instance/new") []
+      (wrap-routes
-        route-new!)
+       (middleware-schema/wrap-allowed-to-write!
-  (GET (register! :instance-show "/instance/:uuid")
+        schema-uuid-by-instance))))
-       [uuid :as req]
+
-       (route-show! uuid req))
+(def writing-routes-with-uuid-in-path
+  (wrap-routes
+   (compojure/routes
     (GET (register! :instance-edit-form "/instance/:uuid/edit")
       [uuid :as req]
       (route-edit-form! uuid req))
@@ -171,14 +197,6 @@
     (DELETE (register! :instance-delete "/instance/:uuid")
       [uuid]
       (route-delete! uuid))
-  (GET (register! :instance-link-selection
-                  "/instance/:uuid/link/:schema-uuid")
-       [uuid schema-uuid :as req]
-       (route-link-selection! uuid schema-uuid req))
-  (POST (register! :instance-link-create
-                   "/instance/:uuid/link/:schema-uuid")
-        [uuid schema-uuid :as req]
-        (route-create-link! uuid schema-uuid req))
     (DELETE (register! :instance-link-delete
                        "/instance/:uuid/link/:link-uuid")
       [uuid link-uuid]
@@ -191,12 +209,43 @@
                        "/instance/:uuid/starred")
       [uuid :as req]
       (route-remove-starred! uuid req))
-  (GET (register! :instance-list-starred "/instance/starred/list")
-       [:as req]
-       (route-list-starred! req))
     (GET (register! :instance-bulk-link-selection "/instance/:uuid/bulk-link")
       [uuid :as req]
       (route-bulk-link-selection! uuid req))
     (POST (register! :instance-bulk-link-create "/instance/:uuid/bulk-link")
       [uuid :as req]
       (route-create-bulk-link! uuid req)))
+   (middleware-schema/wrap-allowed-to-write!
+    schema-uuid-by-instance)))
+
+(defroutes routes
+  ;; read routes with :schema-uuid
+  (wrap-routes
+   (compojure/routes
+    (GET (register! :instance-list "/instance/list/:schema-uuid")
+      [schema-uuid :as req]
+      (route-list! schema-uuid req)))
+   (middleware-schema/wrap-allowed-to-read!
+    schema-uuid-from-params))
+  (wrap-routes
+   (compojure/routes
+    (GET (register! :instance-show "/instance/:uuid")
+      [uuid :as req]
+      (route-show! uuid req)))
+   (middleware-schema/wrap-allowed-to-read!
+    schema-uuid-by-instance))
+  (wrap-routes
+   (compojure/routes
+    (POST (register! :instance-new "/instance/new") []
+      route-new!))
+   (middleware-schema/wrap-allowed-to-write!
+    schema-uuid-from-params))
+  linking-routes
+  writing-routes-with-uuid-in-path
+  (GET (register! :instance-list-starred "/instance/starred/list")
+    [:as req]
+       ;; at some point someone will star an instance and then permissions to
+       ;; the schema will be revoked
+       ;; the instances will still be visible but can't be opened anymore
+       ;; because of missing permissions, so they can't be unstared anymore
+    (route-list-starred! req)))

src/wanijo/instance/view/bulk_link_selection.clj

@@ -1,9 +1,9 @@
 (ns wanijo.instance.view.bulk-link-selection
   (:require [hiccup.form :as hform]
             [hiccup.core :refer [h]]
-            [wanijo.infrastructure.view :as view]
+            [wanijo.infra.view :as view]
-            [wanijo.infrastructure.routing :refer [path]]
+            [wanijo.infra.routing :refer [path]]
-            [wanijo.infrastructure.time :refer [prettify-dt]]
+            [wanijo.infra.time :refer [prettify-dt]]
             [wanijo.instance.view.view
              :refer [req-attrs-headings
                      req-attrs-cells

src/wanijo/instance/view/edit.clj

@@ -2,9 +2,9 @@
   (:require [hiccup.form :as hform]
             [hiccup.core :refer [h]]
             [ring.util.anti-forgery :refer [anti-forgery-field]]
-            [wanijo.infrastructure.view :as view]
+            [wanijo.infra.view :as view]
-            [wanijo.infrastructure.routing :refer [path]]
+            [wanijo.infra.routing :refer [path]]
-            [wanijo.infrastructure.time :refer [prettify-dt]]
+            [wanijo.infra.time :refer [prettify-dt]]
             [wanijo.tag.view :as view-tag]
             [formulare.core :as form]))
 
@@ -26,9 +26,11 @@
            "Back to Instance"]]]
      [:section.edit-instance
       [:h2 "Edit Instance"]
-      (hform/form-to [:post (path :instance-edit instance)]
+      [:form {:method "post"
+              :action (path :instance-edit instance)
+              :enctype "multipart/form-data"}
        (form/render-widgets form form-data req)
-                     (hform/submit-button "Edit!"))
+       (hform/submit-button "Edit!")]
       (hform/form-to [:delete (path :instance-delete instance)]
                      (anti-forgery-field)
                      (view/delete-btn))]

src/wanijo/instance/view/instances.clj

@@ -3,9 +3,9 @@
             [hiccup.core :refer [h]]
             [formulare.core :as form]
             [wanijo.instance.view.view :as view-instance]
-            [wanijo.infrastructure.view :as view]
+            [wanijo.infra.view :as view]
-            [wanijo.infrastructure.routing :refer [path]]
+            [wanijo.infra.routing :refer [path]]
-            [wanijo.infrastructure.time :refer [prettify-dt]]))
+            [wanijo.infra.time :refer [prettify-dt]]))
 
 (defn instances [schema instances new-form req]
   (view/layout

src/wanijo/instance/view/link_selection.clj

@@ -1,8 +1,8 @@
 (ns wanijo.instance.view.link-selection
   (:require [hiccup.form :as hform]
             [hiccup.core :refer [h]]
-            [wanijo.infrastructure.view :as view]
+            [wanijo.infra.view :as view]
-            [wanijo.infrastructure.routing :refer [path]]
+            [wanijo.infra.routing :refer [path]]
             [formulare.core :as form]))
 
 (defn link-selection [instance schema form req]

src/wanijo/instance/view/show.clj

@@ -2,9 +2,9 @@
   (:require [hiccup.form :as hform]
             [hiccup.core :refer [h]]
             [ring.util.anti-forgery :refer [anti-forgery-field]]
-            [wanijo.infrastructure.view :as view]
+            [wanijo.infra.view :as view]
-            [wanijo.infrastructure.routing :refer [path]]
+            [wanijo.infra.routing :refer [path]]
-            [wanijo.infrastructure.time :refer [prettify-dt]]
+            [wanijo.infra.time :refer [prettify-dt]]
             [wanijo.instance.view.view :as view-instance]
             [wanijo.tag.view :as view-tag]
             [markdown.core :as md]

src/wanijo/instance/view/starred.clj

@@ -1,8 +1,8 @@
 (ns wanijo.instance.view.starred
   (:require [hiccup.core :refer [h]]
-            [wanijo.infrastructure.view :as view]
+            [wanijo.infra.view :as view]
-            [wanijo.infrastructure.routing :refer [path]]
+            [wanijo.infra.routing :refer [path]]
-            [wanijo.infrastructure.time :refer [prettify-dt]]))
+            [wanijo.infra.time :refer [prettify-dt]]))
 
 (defn starred [instances req]
   (view/layout

src/wanijo/link/db.clj

@@ -1,7 +1,7 @@
 (ns wanijo.link.db
   (:require [clojure.spec.alpha :as spec]
             [wanijo.specs :as specs]
-            [wanijo.infrastructure.neo4j :as neo4j]))
+            [wanijo.infra.neo4j :as neo4j]))
 
 (spec/def ::link
   (spec/keys :req-un [::neo4j/uuid

src/wanijo/schema/db.clj

@@ -1,17 +1,18 @@
 (ns wanijo.schema.db
-  (:require [wanijo.infrastructure.neo4j :as neo4j]
+  (:require [wanijo.infra.neo4j :as neo4j]
             [wanijo.schema.domain :as domain]
             [clojure.spec.alpha :as spec]))
 
-(neo4j/defquery all-created-by
+(neo4j/defquery all-readable-by
-  "MATCH (s:schema)-[:created_by]->(u:user)
+  "MATCH (s:schema)-[p:permission]-(u:user)
    WHERE u.uuid = $uuid
+     AND p.type IN ['read', 'write']
    RETURN s
    ORDER BY s.name")
-(defn all-created-by! [user-uuid]
+(defn all-readable-by! [user-uuid]
   (map :s
        (neo4j/exec-query!
-         all-created-by
+         all-readable-by
          {:uuid user-uuid})))
 
 (neo4j/defquery all
@@ -29,6 +30,8 @@
    SET s.name = $name
    SET s.uuid = $s_uuid
    SET s.created_at = $created_at
+   WITH u, s
+   CREATE (u)-[:permission {type:'write'}]->(s)
    RETURN s")
 (defn create-new! [schema-name user-uuid]
   (->>
@@ -64,10 +67,13 @@
    RETURN
      EXISTS((:user {uuid: $user_uuid})
             -[:permission {type: $type}]-
-            (s)) AS user_has_permission,
+            (s))
-     NOT EXISTS((:user)
+     OR
-                -[:permission {type: $type}]-
+     EXISTS((:user {uuid : $user_uuid})
-                (s)) AS is_public")
+            -[:permission {type: 'write'}]-
+            (s))
+       AS user_has_permission,
+     NOT EXISTS((:user)-[:permission]-(s)) AS is_public")
 (defn has-user-permission? [perm-type schema-uuid user-uuid]
   (let [perms (first
                 (neo4j/exec-query! schema-permissions

src/wanijo/schema/domain.clj

@@ -2,7 +2,7 @@
   (:require [clojure.spec.alpha :as spec]
             [wanijo.specs :as specs]
             [wanijo.attribute.domain :as domain-attr]
-            [wanijo.infrastructure.neo4j :as neo4j]))
+            [wanijo.infra.neo4j :as neo4j]))
 
 (spec/def ::name
   (spec/and ::specs/name (complement empty?)))

src/wanijo/schema/forms.clj

@@ -39,12 +39,15 @@
             :uuid  {:widget :hidden}}
    :form-specs [::unique-attr-name-per-schema]})
 
-(def assign-form
+(defn assign-form [users]
   {:fields {:assigned {:label "Users"
                        :required false
                        :spec :wanijo.schema.domain/assigned-to
                        :widget :mselect
-                       :from-req #(if (vector? %) % [%])}
+                       :from-req #(if (vector? %) % [%])
+                       :options (map #(vector (:ident %) (:uuid %))
+                                     users)
+                       :size (min 20 (count users))}
             :uuid {:widget :hidden}}})
 
 (def schema-connections-form

src/wanijo/schema/middleware.clj

@@ -1,6 +1,6 @@
 (ns wanijo.schema.middleware
   (:require [ring.util.response :as resp]
-            [wanijo.infrastructure.routing :refer [path]]
+            [wanijo.infra.routing :refer [path]]
             [wanijo.schema.db :as db]))
 
 (defn wrap-user-schemas! [handler]
@@ -8,7 +8,7 @@
     (if-let [uuid (get-in req [:session :uuid])]
       (handler (assoc-in req
                          [:session :schemas]
-                         (db/accessible-schemas! uuid)))
+                         (db/all-readable-by! uuid)))
       (handler req))))
 
 (defn write-permission-middleware! [schema-fn]
@@ -21,19 +21,18 @@
            (resp/redirect (path :schema-show {:uuid uuid}))
            :flash ["No write permission for schema"]))))))
 
-(defn wrap-allowed-to-write! []
+(defn wrap-allowed-to-write!
-  (write-permission-middleware! #(get-in % [:params :uuid])))
+  ([schema-fn]
+   (write-permission-middleware! schema-fn))
+  ([]
+   (write-permission-middleware! #(get-in % [:params :uuid]))))
 
 (defn wrap-allowed-to-read!
-  ([schema-fn]
+  [schema-fn]
-   (wrap-allowed-to-read! schema-fn
-                          (fn [_]
-                            (assoc (resp/redirect (path :schema-overview))
-                                   :flash ["No read permission for schema"]))))
-  ([schema-fn not-allowed-fn]
   (fn [handler]
     (fn [req]
       (let [uuid (schema-fn req)]
         (if (db/has-user-read-permissions? uuid (-> req :session :uuid))
           (handler req)
-           (not-allowed-fn req)))))))
+          (assoc (resp/redirect (path :home))
+            :flash ["No read permission for schema"]))))))

src/wanijo/schema/routes.clj

@@ -2,7 +2,7 @@
   (:require [compojure.core :refer [defroutes GET POST DELETE] :as comp]
             [ring.util.response :as resp]
             [formulare.core :as form]
-            [wanijo.infrastructure.routing :refer [register! path]]
+            [wanijo.infra.routing :refer [register! path]]
             [wanijo.user.db :as domain-user]
             [wanijo.schema
              [view :as schema-view]
@@ -28,10 +28,7 @@
   (schema-view/show-schema!
    (domain/find-with-assigned-entities! uuid)
    (db-attr/find-by-schema! uuid)
-   (assoc-in schema-forms/assign-form
+   (schema-forms/assign-form (domain-user/all!))
-             [:fields :assigned :options]
-             (map #(vector (:ident %) (:uuid %))
-                  (domain-user/all!)))
    (assoc-in schema-forms/schema-connections-form
              [:fields :connections :options]
              (map #(vector (:name %) (:uuid %))
@@ -47,9 +44,10 @@
       (view! uuid req))))
 
 (defn assign-users! [req]
-  (let [{:keys [uuid assigned]} (form/form-data schema-forms/assign-form req)
+  (let [assign-form (schema-forms/assign-form (domain-user/all!))
+        {:keys [uuid assigned]} (form/form-data assign-form req)
         permission (get-in req [:params :permission])]
-    (if (form/valid? schema-forms/assign-form req)
+    (if (form/valid? assign-form req)
       (do
         (domain/assign-users! uuid assigned permission)
         (resp/redirect (path :schema-show (:params req))))

src/wanijo/schema/view.clj

@@ -4,16 +4,16 @@
              [core :refer [h]]]
             [ring.util.anti-forgery :refer [anti-forgery-field]]
             [formulare.core :as form]
-            [wanijo.infrastructure.view :as view]
+            [wanijo.infra.view :as view]
-            [wanijo.infrastructure.routing :refer [path]]
+            [wanijo.infra.routing :refer [path]]
-            [wanijo.infrastructure.time :refer [prettify-dt]]
+            [wanijo.infra.time :refer [prettify-dt]]
             [wanijo.schema.db :as domain]
             [wanijo.schema.forms :as forms]))
 
 (defn overview! [req]
   (let [session (:session req)
         uuid (:uuid session)
-        schemas (domain/all-created-by! uuid)]
+        schemas (domain/all-readable-by! uuid)]
     (view/layout
      :request req
      :content
@@ -50,7 +50,8 @@
     [:h2 "Permissions"]
     [:h3 "Read permissions"]
     (hform/form-to [:post (path :schema-assign-users)]
-                   (form/render-widgets assign-form
+                   (form/render-widgets
+                     assign-form
                      (assoc schema :assigned
                                    (:assigned-read-users schema))
                      req)
@@ -58,7 +59,8 @@
                    (hform/submit-button "Assign"))
     [:h3 "Write permissions"]
     (hform/form-to [:post (path :schema-assign-users)]
-                   (form/render-widgets assign-form
+                   (form/render-widgets
+                     assign-form
                      (assoc schema :assigned
                                    (:assigned-write-users schema))
                      req)

src/wanijo/specs.clj

@@ -1,6 +1,6 @@
 (ns wanijo.specs
   (:require [clojure.spec.alpha :as spec]
-            [wanijo.infrastructure.neo4j :as neo4j]))
+            [wanijo.infra.neo4j :as neo4j]))
 
 (spec/def ::created_at ::neo4j/date-str)
 (spec/def ::updated_at ::neo4j/date-str)

src/wanijo/tag/db.clj

@@ -1,7 +1,7 @@
 (ns wanijo.tag.db
   (:require [clojure.spec.alpha :as spec]
             [wanijo.specs :as specs]
-            [wanijo.infrastructure.neo4j :as neo4j]))
+            [wanijo.infra.neo4j :as neo4j]))
 
 (spec/def ::name
   (spec/and ::specs/name

src/wanijo/tag/routes.clj

@@ -2,7 +2,7 @@
   (:require [compojure.core :refer [defroutes POST DELETE]]
             [ring.util.response :as resp]
             [formulare.core :as form]
-            [wanijo.infrastructure.routing :refer [register! path]]
+            [wanijo.infra.routing :refer [register! path]]
             [wanijo.schema.db :as domain-schema]
             [wanijo.instance.db :as db-instance]
             [wanijo.instance.view.show :refer [show]]

src/wanijo/tag/view.clj

@@ -4,7 +4,7 @@
             [ring.util.anti-forgery :refer [anti-forgery-field]]
             [formulare.core :as form]
             [wanijo.tag.forms :as forms]
-            [wanijo.infrastructure
+            [wanijo.infra
              [routing :refer [path]]
              [view :as view]
              [time :refer [prettify-dt]]]))

src/wanijo/user/db.clj

@@ -1,6 +1,6 @@
 (ns wanijo.user.db
   (:require [clojure.spec.alpha :as spec]
-            [wanijo.infrastructure.neo4j :as neo4j]))
+            [wanijo.infra.neo4j :as neo4j]))
 
 (spec/def ::ident
   (spec/and string? not-empty))

src/wanijo/user/routes.clj

@@ -1,7 +1,7 @@
 (ns wanijo.user.routes
   (:require [compojure.core :refer [defroutes GET POST]]
             [ring.util.response :as resp]
-            [wanijo.infrastructure.routing :refer [register!]]
+            [wanijo.infra.routing :refer [register!]]
             [wanijo.user.view :as view-user]
             [wanijo.user.db :as domain]))
 

src/wanijo/user/view.clj

@@ -2,8 +2,8 @@
   (:require [hiccup.form :as hform]
             [ring.util.anti-forgery :refer [anti-forgery-field]]
             [formulare.core :as form]
-            [wanijo.infrastructure.view :as view]
+            [wanijo.infra.view :as view]
-            [wanijo.infrastructure.routing :refer [path]]
+            [wanijo.infra.routing :refer [path]]
             [wanijo.user.db :as domain]))
 
 (def edit-form

src/wanijo/visualisation/db.clj

@@ -1,6 +1,6 @@
 (ns wanijo.visualisation.db
   (:require [clojure.spec.alpha :as spec]
-            [wanijo.infrastructure.neo4j :as neo4j]
+            [wanijo.infra.neo4j :as neo4j]
             [wanijo.instance.db :as db-instance]
             [wanijo.instance.domain :as domain-instance]))
 

src/wanijo/visualisation/routes.clj

@@ -1,7 +1,7 @@
 (ns wanijo.visualisation.routes
   (:require [compojure.core :refer [defroutes wrap-routes
                                     GET POST DELETE]]
-            [wanijo.infrastructure
+            [wanijo.infra
              [routing :refer [register! path]]
              [view :as view]]
             [wanijo.instance.db :as db-instance]

src/wanijo/visualisation/view.clj

@@ -2,8 +2,8 @@
   (:require [hiccup.page :refer [include-js include-css]]
             [hiccup.form :as hform]
             [hiccup.core :refer [h]]
-            [wanijo.infrastructure.routing :refer [path]]
+            [wanijo.infra.routing :refer [path]]
-            [wanijo.infrastructure.view :as view]))
+            [wanijo.infra.view :as view]))
 
 (defn index [instance req]
   (view/layout

src/wanijo/visualisation/viz.clj

@@ -3,7 +3,7 @@
             [dorothy
              [core :as dot]
              [jvm :as doro-jvm]]
-            [wanijo.infrastructure.routing :refer [path]]))
+            [wanijo.infra.routing :refer [path]]))
 
 (defn node->label
   ([node]

test/wanijo/infra/routing_test.clj

@@ -1,6 +1,6 @@
-(ns wanijo.infrastructure.routing-test
+(ns wanijo.infra.routing-test
   (:require [clojure.test :refer :all]
-            [wanijo.infrastructure.routing :refer [parse-path]]))
+            [wanijo.infra.routing :refer [parse-path]]))
 
 (deftest test-parse-path
   (testing "no params in path"

test/wanijo/infra/system_test.clj

@@ -0,0 +1,189 @@
+(ns wanijo.infra.system-test
+  (:require [clojure.test :refer [deftest testing is]]
+            [neo4j-clj.core :as drv]
+            [clojure.string :as string]
+            [wanijo.infra.neo4j :as neo4j]
+            [wanijo.infra.repl :as repl]
+            [wanijo.schema.routes :as schema-routes]
+            [wanijo.attribute.routes :as attr-routes]
+            [wanijo.instance.routes :as inst-routes]
+            [wanijo.instance.forms :as inst-forms]
+            [wanijo.instance.db :as inst-db]
+            [clojure.pprint :as pp]))
+
+(defn single-result
+  ([cypher]
+   (single-result cypher
+                  #(val (first %))))
+  ([cypher extractor]
+   (extractor
+    (first
+     (neo4j/exec-query!
+      (drv/create-query cypher) {})))))
+
+(defn multi-results [cypher extractor]
+  (extractor
+   (neo4j/exec-query!
+    (drv/create-query cypher) {})))
+
+(deftest allround-system-test
+  (repl/setup-in-memory!)
+  (def user
+    (single-result "MATCH (u:user) RETURN u"
+                   :u))
+
+  (testing "create schema"
+    (schema-routes/new! {:params {:name "test-schema"}
+                         :session {:uuid (:uuid user)}})
+    (def schema
+      (single-result "MATCH (s:schema) RETURN s LIMIT 1" :s))
+    (is (= "test-schema" (:name schema)))
+    (is (not= nil (:created_at schema)))
+    (is (= (:uuid user)
+           (single-result "MATCH (s:schema)-[:created_by]->(u:user)
+                           RETURN u.uuid")))
+    (is (= (:uuid user)
+           (single-result "MATCH (s:schema)
+                                 <-[:permission {type:'write'}]-(u:user)
+                           RETURN u.uuid"))))
+
+  (testing "create attribute"
+    (attr-routes/new! {:params {:schema (:uuid schema)
+                                :name "test-attr"
+                                :type "string"
+                                :required "1"}
+                       :session {:uuid (:uuid user)}})
+    (def attr
+      (single-result "MATCH (a:attribute) RETURN a"))
+    (is (= "string" (:type attr)))
+    (is (= "test-attr" (:name attr)))
+    (is (= 1 (:required attr)))
+    (is (= (:uuid user)
+           (single-result "MATCH (a:attribute)-[:created_by]->(u:user)
+                           RETURN u.uuid")))
+    (is (= (:uuid schema)
+           (single-result "MATCH (a:attribute)-[:of]->(s:schema)
+                           RETURN s.uuid"))))
+
+  (testing "assign read"
+    (schema-routes/assign-users! {:params {:uuid (:uuid schema)
+                                           :assigned [(:uuid user)]
+                                           :permission "read"}})
+    (is (= (list ["read" (:uuid user)] ["write" (:uuid user)])
+           (multi-results "MATCH (s:schema)
+                                 <-[p:permission]-(u:user)
+                           RETURN p.type AS type, u.uuid AS uuid"
+                          #(map (juxt :type :uuid) %)))))
+
+  (testing "create instance"
+    (inst-routes/route-new!
+     {:params {:schema-uuid (:uuid schema)
+               :name "instance"
+               (inst-forms/attr->field-id attr) "attr-value"}
+      :session {:uuid (:uuid user)}})
+    (def instance
+      (single-result "MATCH (i:instance) RETURN i"))
+    (is (= "attr-value"
+           (single-result "MATCH (p:property) RETURN p.value")))
+    (is (= (:uuid user)
+           (single-result "MATCH (i:instance)-[:created_by]->(u:user)
+                           RETURN u.uuid")))
+    (let [full-inst (inst-db/full-instance-by-uuid! (:uuid instance))]
+      (is (= "attr-value"
+             (-> full-inst :properties first :value)))
+      (is (= (:uuid attr)
+             (-> full-inst :properties first :attribute :uuid)))
+      (is (empty? (:tags full-inst)))
+      (is (empty? (:links-in full-inst)))
+      (is (empty? (:links-out full-inst)))))
+
+  (testing "create second instance and linking"
+    (inst-routes/route-new!
+     {:params {:schema-uuid (:uuid schema)
+               :name "instance2"
+               (inst-forms/attr->field-id attr) "attr-value2"}
+      :session {:uuid (:uuid user)}})
+    (def instance2
+      (single-result "MATCH (i:instance)
+                      WITH MAX(i.created_at) AS max_created_at
+                      MATCH (i:instance)
+                      WHERE i.created_at = max_created_at
+                      RETURN i"))
+    (is (= "instance2" (:name instance2)))
+
+    (inst-routes/route-create-link!
+     (:uuid instance)
+     (:uuid schema)
+     {:params {:name "link-name"
+               :instances [(:uuid instance2)]}
+      :session {:uuid (:uuid user)}})
+    (let [link (single-result "MATCH ()-[l:link]-() RETURN l")]
+      (is (= "link-name" (:name link)))
+      (is (= (:uuid user) (:created_by link)))
+      (is (some? (:created_at link))))
+
+    (is (= (:uuid instance)
+           (single-result "MATCH (i:instance)-[:link]->(:instance)
+                           RETURN i.uuid")))
+
+    (is (= (:uuid instance2)
+           (single-result "MATCH (i:instance)<-[:link]-(:instance)
+                           RETURN i.uuid"))))
+
+  (testing "show instances"
+    (let [resp (inst-routes/route-show!
+                (:uuid instance)
+                {:session {:uuid (:uuid user)}})]
+      (is (true? (string? resp)))
+      (is (true? (string/includes? resp (:name instance))))
+      (is (true? (string/includes? resp (:name schema)))))
+    (let [resp (inst-routes/route-show!
+                (:uuid instance2)
+                {:session {:uuid (:uuid user)}})]
+      (is (true? (string? resp)))
+      (is (true? (string/includes? resp (:name instance))))
+      (is (true? (string/includes? resp (:name schema))))))
+
+  (testing "modifying first instance"
+    (let [prop-uuid (single-result
+                     (str
+                      "MATCH (i:instance)<-[:of]-(p:property)
+                       WHERE i.uuid = '" (:uuid instance) "'
+                       RETURN p.uuid"))]
+      (inst-routes/route-edit!
+       (:uuid instance)
+       {:params {:name "new-instance-1"
+                 (inst-forms/attr->field-id attr) "new-value"
+                 (inst-forms/attr->uuid-field-id attr) prop-uuid}
+        :session {:uuid (:uuid user)}})
+      (is (= "new-value"
+             (single-result
+              (str
+               "MATCH (p:property)
+                WHERE p.uuid = '" prop-uuid "'
+                RETURN p.value"))))
+      (is (= "new-value"
+             (single-result
+              (str
+               "MATCH (rp:rev_property)
+                      -[:of]->(rev:revision)
+                      -[:of]->(i:instance)
+                WHERE i.uuid = '" (:uuid instance) "'
+                RETURN rp.value"))))
+      (is (= 1 (single-result "MATCH (r:revision) RETURN COUNT(r)")))))
+
+  (testing "delete first instance"
+    (inst-routes/route-delete! (:uuid instance))
+    (is (= 1 (single-result "MATCH (i:instance) RETURN COUNT(i)")))
+    (is (= 1 (single-result "MATCH (p:property) RETURN COUNT(p)")))
+    (is (= 1 (single-result "MATCH (s:schema) RETURN COUNT(s)")))
+    (is (= 0 (single-result "MATCH ()-[l:link]-() RETURN COUNT(l)"))))
+
+  (testing "delete second instance"
+    (inst-routes/route-delete! (:uuid instance2))
+    (is (= 0 (single-result "MATCH (i:instance) RETURN COUNT(i)")))
+    (is (= 0 (single-result "MATCH (p:property) RETURN COUNT(p)")))
+    (is (= 1 (single-result "MATCH (s:schema) RETURN COUNT(s)")))))
+
+(comment
+  (allround-system-test))