Compare commits
27 Commits
| Author | SHA1 | Date |
|---|---|---|
josha.von.gizycki
|
7d7218a93f | 1 year ago |
|
josha.von.gizycki
|
86b872e01e | 1 year ago |
|
josha.von.gizycki
|
f0071176b3 | 1 year ago |
|
Josha von Gizycki
|
c7b3f4e69a | 2 years ago |
|
Josha von Gizycki
|
57412a5544 | 2 years ago |
|
Josha von Gizycki
|
0d9e44b75d | 3 years ago |
|
Josha von Gizycki
|
5f3ed0e363 | 3 years ago |
|
Josha von Gizycki
|
2c33c6cdcc | 3 years ago |
|
Josha von Gizycki
|
21ef517cec | 3 years ago |
|
Josha von Gizycki
|
4e5c86b808 | 3 years ago |
|
Josha von Gizycki
|
133eb49d6b | 4 years ago |
|
Josha von Gizycki
|
d5788b1e84 | 4 years ago |
|
Josha von Gizycki
|
5cf380858a | 4 years ago |
|
Josha von Gizycki
|
6836ea33d8 | 4 years ago |
|
Josha von Gizycki
|
cde6313108 | 4 years ago |
|
Josha von Gizycki
|
5c7f578704 | 4 years ago |
|
Josha von Gizycki
|
3b8e6f196a | 4 years ago |
|
Josha von Gizycki
|
bc0585f772 | 4 years ago |
|
Josha von Gizycki
|
4e3f0f86bd | 4 years ago |
|
Josha von Gizycki
|
08fc2403a1 | 4 years ago |
|
Josha von Gizycki
|
d68cf05e47 | 4 years ago |
|
Josha von Gizycki
|
d81106b7c3 | 4 years ago |
|
Josha von Gizycki
|
5e28072b24 | 4 years ago |
|
Josha von Gizycki
|
5c7f71b368 | 4 years ago |
|
Josha von Gizycki
|
8d92817e15 | 4 years ago |
|
Josha von Gizycki
|
a52c15649e | 4 years ago |
|
Josha von Gizycki
|
61d1b55240 | 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,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;
|
||||
}
|
||||
@ -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.home.view
|
||||
(:require [wanijo.infrastructure.view :as view]))
|
||||
(:require [wanijo.infra.view :as view]))
|
||||
|
||||
(defn root! [req]
|
||||
(view/layout :session (:session req)))
|
||||
(view/layout :request req))
|
||||
|
||||
@ -1,11 +1,11 @@
|
||||
(ns wanijo.infrastructure.auth
|
||||
(ns wanijo.infra.auth
|
||||
(:require [compojure.core :refer [POST GET defroutes]]
|
||||
[ring.util.response :refer [redirect]]
|
||||
[ring.util.anti-forgery :refer [anti-forgery-field]]
|
||||
[buddy.hashers :as hashers]
|
||||
[hiccup.form :as hform]
|
||||
[wanijo.infrastructure.view :as view]
|
||||
[wanijo.infrastructure.routing :refer [register! path]]
|
||||
[wanijo.infra.view :as view]
|
||||
[wanijo.infra.routing :refer [register! path]]
|
||||
[wanijo.user.db :as user-domain]))
|
||||
|
||||
(defn- login-check! [req]
|
||||
@ -1,4 +1,4 @@
|
||||
(ns wanijo.infrastructure.common)
|
||||
(ns wanijo.infra.common)
|
||||
|
||||
(defn in? [coll x]
|
||||
(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,4 +1,4 @@
|
||||
(ns wanijo.infrastructure.routing
|
||||
(ns wanijo.infra.routing
|
||||
(:require [clojure.string :as string]))
|
||||
|
||||
(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]))
|
||||
|
||||
(defn prettify-dt [date-str]
|
||||
@ -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)))
|
||||
@ -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)}))))
|
||||
)
|
||||
@ -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,6 @@
|
||||
(ns wanijo.infrastructure.routing-test
|
||||
(ns wanijo.infra.routing-test
|
||||
(:require [clojure.test :refer :all]
|
||||
[wanijo.infrastructure.routing :refer [parse-path]]))
|
||||
[wanijo.infra.routing :refer [parse-path]]))
|
||||
|
||||
(deftest test-parse-path
|
||||
(testing "no params in path"
|
||||
@ -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…
Reference in new issue