Compare commits

...

27 Commits

Author SHA1 Message Date
josha.von.gizycki 7d7218a93f add assertion
1 year ago
josha.von.gizycki 86b872e01e v0.3.1
1 year ago
josha.von.gizycki f0071176b3 re-add nrepl as dependency
1 year ago
Josha von Gizycki c7b3f4e69a fix deletion of instances with revisions
2 years ago
Josha von Gizycki 57412a5544 add test that proves deleting edited instances breaks
2 years ago
Josha von Gizycki 0d9e44b75d add basic responsive layout
3 years ago
Josha von Gizycki 5f3ed0e363 write files when uploading
3 years ago
Josha von Gizycki 2c33c6cdcc preparations for file upload - move formulare into wanijo
3 years ago
Josha von Gizycki 21ef517cec creation of revisions
3 years ago
Josha von Gizycki 4e5c86b808 updates from trio branch, tests
3 years ago
Josha von Gizycki 133eb49d6b alfred job file
4 years ago
Josha von Gizycki d5788b1e84 fix assign form usage
4 years ago
Josha von Gizycki 5cf380858a add .lsp to gitignore
4 years ago
Josha von Gizycki 6836ea33d8 clean up transitive dependencies
4 years ago
Josha von Gizycki cde6313108 add three more test cases to system test
4 years ago
Josha von Gizycki 5c7f578704 add tests for linking
4 years ago
Josha von Gizycki 3b8e6f196a add instance test
4 years ago
Josha von Gizycki bc0585f772 refactor system test to use controller functions
4 years ago
Josha von Gizycki 4e3f0f86bd first part of an automated system test
4 years ago
Josha von Gizycki 08fc2403a1 proper permissions in instance routes, qol on assigning forms in schemas
4 years ago
Josha von Gizycki d68cf05e47 list only schemas you have permissions for
4 years ago
Josha von Gizycki d81106b7c3 rename wanijo.infrastructure to wanijo.infra
4 years ago
Josha von Gizycki 5e28072b24 remove unused file
4 years ago
Josha von Gizycki 5c7f71b368 the next restyling, some restructuring
4 years ago
Josha von Gizycki 8d92817e15 implement on-demand numerical sort in dyntables
4 years ago
Josha von Gizycki a52c15649e Merge branch 'neo4j-4'
4 years ago
Josha von Gizycki 61d1b55240 fix weird degradation of neo4j-clj
4 years ago

@ -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;

1
.gitignore vendored

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

@ -16,16 +16,16 @@ You'll need:
- start a neo4j database with `lein neo4j` - start a neo4j database with `lein neo4j`
- start a repl with `lein repl` or similar - 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 - 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 ### Launch the application server
- start a repl - 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` - the application is available on port `8080`
## Launch as a standalone ## 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.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.

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

@ -106,42 +106,44 @@ img, svg {
display: grid; display: grid;
grid-template-columns: 40% 60%; grid-template-columns: 40% 60%;
align-items: center; align-items: center;
margin-top: 0; margin: 0 @element-margin;
background-color: ThreeDShadow;
//noinspection CssUnknownTarget //noinspection CssUnknownTarget
background-image: url("/img/logo-full-flipped.svg"); background-image: url("/img/logo-full-flipped.svg");
background-size: contain; background-size: contain;
background-position: right; background-position: right;
background-origin: content-box; background-origin: content-box;
background-repeat: no-repeat; background-repeat: no-repeat;
border-bottom: 1px solid @ci-highlight; border-bottom: 1px solid @ci-color;
.app-title { .app-title {
grid-column: 1; grid-column: 1;
font-size: 1.5rem; font-size: 1.5rem;
}
.app-title__hello { .app-title__hello {
font-size: 1rem; font-size: 1rem;
margin-left: @text-padding-h; margin-left: @text-padding-h;
font-weight: normal; font-weight: normal;
font-style: italic; font-style: italic;
}
} }
.header-content { .header-content {
grid-column: 2; grid-column: 2;
}
.header-content__link { .header-content__link {
display: inline-block; display: inline-block;
margin-right: @accent-border-width; margin-right: @accent-border-width;
}
} }
} }
nav { nav {
grid-area: 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 { h2::before {
content: "▤ "; content: "▤ ";
@ -387,3 +389,21 @@ table {
border: 1px solid @ci-highlight; border: 1px solid @ci-highlight;
height: 45rem; 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;
}
}
}
}

@ -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;
}
}
}
}

@ -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;
}

@ -237,13 +237,13 @@ document.addEventListener('DOMContentLoaded', function () {
function onSort(ctx, ix, event) { function onSort(ctx, ix, event) {
const tbl = ctx.tbl const tbl = ctx.tbl
const sortDir = event.target.getAttribute('data-sort') || 'asc' const sortDir = event.target.getAttribute('data-sort') || 'asc'
const sortMod = sortDir === 'asc' ? -1 : 1; const sortMod = sortDir === 'asc' ? -1 : 1;
const rows = tblRows(tbl) const rows = tblRows(tbl)
const newTbody = document.createElement('tbody') const newTbody = document.createElement('tbody')
rows.sort((row1, row2) => { rows.sort((row1, row2) => {
const val1 = row1.cells[ix].textContent const val1 = row1.cells[ix].textContent
const val2 = row2.cells[ix].textContent const val2 = row2.cells[ix].textContent
@ -251,10 +251,10 @@ document.addEventListener('DOMContentLoaded', function () {
: val2 > val1 ? -1 : val2 > val1 ? -1
: 0); : 0);
}) })
rows.forEach(row => newTbody.appendChild(row)) rows.forEach(row => newTbody.appendChild(row))
tbl.replaceChild(newTbody, tbl.tBodies[0]) tbl.replaceChild(newTbody, tbl.tBodies[0])
clearSortAttributes(tbl) clearSortAttributes(tbl)
event.target.setAttribute('data-sort', flipSortDir(sortDir)) event.target.setAttribute('data-sort', flipSortDir(sortDir))
changePage(ctx, 0) changePage(ctx, 0)

@ -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)

@ -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}])

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

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

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

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

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

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

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

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

@ -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))))

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

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

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

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

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

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

@ -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)))

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

@ -66,3 +66,12 @@
(spec/def ::full-instance (spec/def ::full-instance
(spec/merge ::instance-with-schema (spec/merge ::instance-with-schema
::contains-full-information)) ::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))})

@ -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)}))))
)

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

@ -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)))))

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

@ -1,9 +1,9 @@
(ns wanijo.instance.view.bulk-link-selection (ns wanijo.instance.view.bulk-link-selection
(:require [hiccup.form :as hform] (:require [hiccup.form :as hform]
[hiccup.core :refer [h]] [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 [wanijo.instance.view.view
:refer [req-attrs-headings :refer [req-attrs-headings
req-attrs-cells req-attrs-cells

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

@ -3,9 +3,9 @@
[hiccup.core :refer [h]] [hiccup.core :refer [h]]
[formulare.core :as form] [formulare.core :as form]
[wanijo.instance.view.view :as view-instance] [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] (defn instances [schema instances new-form req]
(view/layout (view/layout

@ -1,8 +1,8 @@
(ns wanijo.instance.view.link-selection (ns wanijo.instance.view.link-selection
(:require [hiccup.form :as hform] (:require [hiccup.form :as hform]
[hiccup.core :refer [h]] [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])) [formulare.core :as form]))
(defn link-selection [instance schema form req] (defn link-selection [instance schema form req]

@ -2,9 +2,9 @@
(:require [hiccup.form :as hform] (:require [hiccup.form :as hform]
[hiccup.core :refer [h]] [hiccup.core :refer [h]]
[ring.util.anti-forgery :refer [anti-forgery-field]] [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.instance.view.view :as view-instance]
[wanijo.tag.view :as view-tag] [wanijo.tag.view :as view-tag]
[markdown.core :as md] [markdown.core :as md]

@ -1,8 +1,8 @@
(ns wanijo.instance.view.starred (ns wanijo.instance.view.starred
(:require [hiccup.core :refer [h]] (: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] (defn starred [instances req]
(view/layout (view/layout

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

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

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

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

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

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

@ -4,16 +4,16 @@
[core :refer [h]]] [core :refer [h]]]
[ring.util.anti-forgery :refer [anti-forgery-field]] [ring.util.anti-forgery :refer [anti-forgery-field]]
[formulare.core :as form] [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.db :as domain]
[wanijo.schema.forms :as forms])) [wanijo.schema.forms :as forms]))
(defn overview! [req] (defn overview! [req]
(let [session (:session req) (let [session (:session req)
uuid (:uuid session) uuid (:uuid session)
schemas (domain/all-created-by! uuid)] schemas (domain/all-readable-by! uuid)]
(view/layout (view/layout
:request req :request req
:content :content
@ -50,18 +50,20 @@
[:h2 "Permissions"] [:h2 "Permissions"]
[:h3 "Read permissions"] [:h3 "Read permissions"]
(hform/form-to [:post (path :schema-assign-users)] (hform/form-to [:post (path :schema-assign-users)]
(form/render-widgets assign-form (form/render-widgets
(assoc schema :assigned assign-form
(:assigned-read-users schema)) (assoc schema :assigned
req) (:assigned-read-users schema))
req)
(hform/hidden-field "permission" "read") (hform/hidden-field "permission" "read")
(hform/submit-button "Assign")) (hform/submit-button "Assign"))
[:h3 "Write permissions"] [:h3 "Write permissions"]
(hform/form-to [:post (path :schema-assign-users)] (hform/form-to [:post (path :schema-assign-users)]
(form/render-widgets assign-form (form/render-widgets
(assoc schema :assigned assign-form
(:assigned-write-users schema)) (assoc schema :assigned
req) (:assigned-write-users schema))
req)
(hform/hidden-field "permission" "write") (hform/hidden-field "permission" "write")
(hform/submit-button "Assign")) (hform/submit-button "Assign"))
[:h3 "Allowed schema connections"] [:h3 "Allowed schema connections"]

@ -1,6 +1,6 @@
(ns wanijo.specs (ns wanijo.specs
(:require [clojure.spec.alpha :as spec] (: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 ::created_at ::neo4j/date-str)
(spec/def ::updated_at ::neo4j/date-str) (spec/def ::updated_at ::neo4j/date-str)

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

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

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

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

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

@ -2,8 +2,8 @@
(:require [hiccup.form :as hform] (:require [hiccup.form :as hform]
[ring.util.anti-forgery :refer [anti-forgery-field]] [ring.util.anti-forgery :refer [anti-forgery-field]]
[formulare.core :as form] [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])) [wanijo.user.db :as domain]))
(def edit-form (def edit-form

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

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

@ -2,8 +2,8 @@
(:require [hiccup.page :refer [include-js include-css]] (:require [hiccup.page :refer [include-js include-css]]
[hiccup.form :as hform] [hiccup.form :as hform]
[hiccup.core :refer [h]] [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] (defn index [instance req]
(view/layout (view/layout

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

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

@ -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))
Loading…
Cancel
Save