Compare commits
No commits in common. 'master' and 'neo4j-4' have entirely different histories.
@ -1,8 +0,0 @@
|
|||||||
#!/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;
|
|
||||||
@ -0,0 +1,24 @@
|
|||||||
|
.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;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
@ -0,0 +1,21 @@
|
|||||||
|
.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;
|
||||||
|
}
|
||||||
@ -1,168 +0,0 @@
|
|||||||
(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)
|
|
||||||
@ -1,85 +0,0 @@
|
|||||||
(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.home.view
|
(ns wanijo.home.view
|
||||||
(:require [wanijo.infra.view :as view]))
|
(:require [wanijo.infrastructure.view :as view]))
|
||||||
|
|
||||||
(defn root! [req]
|
(defn root! [req]
|
||||||
(view/layout :request req))
|
(view/layout :session (:session req)))
|
||||||
|
|||||||
@ -1,77 +0,0 @@
|
|||||||
(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,7 +0,0 @@
|
|||||||
(ns wanijo.infra.sysconfig)
|
|
||||||
|
|
||||||
(defn env
|
|
||||||
([name]
|
|
||||||
(System/getenv name))
|
|
||||||
([name default]
|
|
||||||
(or (System/getenv name) default)))
|
|
||||||
@ -1,11 +1,11 @@
|
|||||||
(ns wanijo.infra.auth
|
(ns wanijo.infrastructure.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.infra.view :as view]
|
[wanijo.infrastructure.view :as view]
|
||||||
[wanijo.infra.routing :refer [register! path]]
|
[wanijo.infrastructure.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.infra.common)
|
(ns wanijo.infrastructure.common)
|
||||||
|
|
||||||
(defn in? [coll x]
|
(defn in? [coll x]
|
||||||
(some? (some (partial = x) coll)))
|
(some? (some (partial = x) coll)))
|
||||||
@ -0,0 +1,46 @@
|
|||||||
|
(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,4 +1,4 @@
|
|||||||
(ns wanijo.infra.routing
|
(ns wanijo.infrastructure.routing
|
||||||
(:require [clojure.string :as string]))
|
(:require [clojure.string :as string]))
|
||||||
|
|
||||||
(def all-routes
|
(def all-routes
|
||||||
@ -1,4 +1,4 @@
|
|||||||
(ns wanijo.infra.time
|
(ns wanijo.infrastructure.time
|
||||||
(:require [clj-time.format :as format]))
|
(:require [clj-time.format :as format]))
|
||||||
|
|
||||||
(defn prettify-dt [date-str]
|
(defn prettify-dt [date-str]
|
||||||
@ -1,50 +0,0 @@
|
|||||||
(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)}))))
|
|
||||||
)
|
|
||||||
@ -1,33 +0,0 @@
|
|||||||
(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,189 +0,0 @@
|
|||||||
(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))
|
|
||||||
@ -1,6 +1,6 @@
|
|||||||
(ns wanijo.infra.routing-test
|
(ns wanijo.infrastructure.routing-test
|
||||||
(:require [clojure.test :refer :all]
|
(:require [clojure.test :refer :all]
|
||||||
[wanijo.infra.routing :refer [parse-path]]))
|
[wanijo.infrastructure.routing :refer [parse-path]]))
|
||||||
|
|
||||||
(deftest test-parse-path
|
(deftest test-parse-path
|
||||||
(testing "no params in path"
|
(testing "no params in path"
|
||||||
Loading…
Reference in new issue