You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
252 lines
9.3 KiB
252 lines
9.3 KiB
(ns wanijo.instance.routes
|
|
(:require [compojure.core :refer [defroutes wrap-routes
|
|
GET POST DELETE]
|
|
:as compojure]
|
|
[ring.util.response :as resp]
|
|
[formulare.core :as form]
|
|
[wanijo.instance.view
|
|
[edit :refer [edit]]
|
|
[instances :refer [instances]]
|
|
[show :refer [show]]
|
|
[link-selection :refer [link-selection]]
|
|
[bulk-link-selection :refer [bulk-link-selection]]
|
|
[starred :refer [starred]]]
|
|
[wanijo.instance
|
|
[db :as db]
|
|
[forms :as forms-inst]
|
|
[domain :as domain]
|
|
[files :as files]]
|
|
[wanijo.schema.db :as domain-schema]
|
|
[wanijo.schema.middleware :as middleware-schema]
|
|
[wanijo.link.db :as domain-link]
|
|
[wanijo.infra.routing :refer [register! path]]
|
|
[wanijo.attribute.db :as db-attr]))
|
|
|
|
(defn route-list! [schema-uuid req]
|
|
(instances (domain-schema/find-by-uuid! schema-uuid)
|
|
(db/find-by-schema! schema-uuid)
|
|
(forms-inst/with-attributes (db-attr/required! schema-uuid))
|
|
req))
|
|
|
|
(defn route-new! [req]
|
|
(let [schema-uuid (get-in req [:params :schema-uuid])
|
|
user-uuid (get-in req [:session :uuid])
|
|
req-attrs (db-attr/required! schema-uuid)
|
|
form-def (forms-inst/with-attributes req-attrs)]
|
|
(if (form/valid? form-def req)
|
|
(let [form-data (form/form-data form-def req)
|
|
req-attrs (db-attr/required! schema-uuid)
|
|
instance (forms-inst/form-data->instance form-data
|
|
req-attrs)]
|
|
(db/create! user-uuid
|
|
schema-uuid
|
|
instance)
|
|
(resp/redirect (path :instance-list
|
|
(:params req))))
|
|
(route-list! schema-uuid req))))
|
|
|
|
(defn instance! [uuid]
|
|
(db/full-instance-by-uuid! uuid))
|
|
|
|
(defn route-show! [uuid req]
|
|
(let [user-uuid (-> req :session :uuid)
|
|
instance (assoc (instance! uuid)
|
|
:starred
|
|
(db/is-starred! uuid
|
|
user-uuid))]
|
|
(show instance
|
|
(domain-schema/accessible-schemas! user-uuid)
|
|
req)))
|
|
|
|
(defn route-edit-form! [uuid req]
|
|
(let [instance (instance! uuid)
|
|
attrs (db-attr/find-by-instance! uuid)
|
|
user-uuid (get-in req [:session :uuid])]
|
|
(edit instance
|
|
(forms-inst/with-attributes attrs)
|
|
(forms-inst/instance->form-data instance)
|
|
(domain-schema/accessible-schemas! user-uuid)
|
|
req)))
|
|
|
|
(comment
|
|
(forms-inst/with-attributes
|
|
(db-attr/find-by-instance!
|
|
"def4dacb-979f-4a0d-b1d6-535ac2a3f94b")))
|
|
|
|
(defn route-edit! [uuid req]
|
|
(let [attrs (db-attr/find-by-instance! uuid)
|
|
form-def (forms-inst/with-attributes attrs)]
|
|
(if (form/valid? form-def req)
|
|
(let [form-data (form/form-data form-def req)
|
|
form-instance (forms-inst/form-data->instance form-data attrs)
|
|
instance (assoc form-instance :uuid uuid)]
|
|
(db/edit! instance (domain/to-revision instance))
|
|
(resp/redirect (path :instance-show instance)))
|
|
(route-show! uuid req))))
|
|
|
|
(defn route-delete! [uuid]
|
|
(let [schema (domain-schema/find-by-instance! uuid)]
|
|
(db/delete! uuid)
|
|
(resp/redirect (path :instance-list
|
|
{:schema-uuid (:uuid schema)}))))
|
|
|
|
(defn link-form! [schema-uuid]
|
|
(forms-inst/link-form
|
|
(db/find-by-schema! schema-uuid)))
|
|
|
|
(defn route-link-selection! [uuid schema-uuid req]
|
|
(link-selection (instance! uuid)
|
|
(domain-schema/find-by-uuid! schema-uuid)
|
|
(link-form! schema-uuid)
|
|
req))
|
|
|
|
(defn route-create-link! [uuid schema-uuid req]
|
|
(let [form (link-form! schema-uuid)]
|
|
(if (form/valid? form req)
|
|
(let [form-data (form/form-data form req)]
|
|
(domain-link/create! {:from uuid
|
|
:name (:name form-data)
|
|
:to (:instances form-data)
|
|
:by (get-in req [:session :uuid])})
|
|
(resp/redirect (path :instance-edit-form {:uuid uuid})))
|
|
(route-link-selection! uuid schema-uuid req))))
|
|
|
|
(comment
|
|
(form/valid? (link-form! "6e7009e3-724b-4fce-afe0-7cf50f0bfcff")
|
|
{:params {:name "link-name"
|
|
:instances ["4bb90cc3-54d1-4d7d-bc30-c357777613ef"]}}))
|
|
|
|
(defn route-delete-link! [uuid link-uuid]
|
|
(domain-link/delete! link-uuid)
|
|
(resp/redirect (path :instance-edit-form {:uuid uuid})))
|
|
|
|
(defn route-mark-starred! [uuid req]
|
|
(db/mark-starred! uuid
|
|
(-> req :session :uuid))
|
|
(resp/redirect (path :instance-show {:uuid uuid})))
|
|
|
|
(defn route-remove-starred! [uuid req]
|
|
(db/remove-starred! uuid
|
|
(-> req :session :uuid))
|
|
(resp/redirect (path :instance-show {:uuid uuid})))
|
|
|
|
(defn route-list-starred! [req]
|
|
(starred
|
|
(db/starred-by-user! (-> req :session :uuid))
|
|
req))
|
|
|
|
(defn route-bulk-link-selection! [uuid req]
|
|
(let [user-uuid (-> req :session :uuid)]
|
|
(bulk-link-selection (db/full-instance-by-uuid! uuid)
|
|
(->> (domain-schema/accessible-schemas!
|
|
user-uuid)
|
|
(map (fn [schema]
|
|
{:schema schema
|
|
:instances (db/find-by-schema!
|
|
(:uuid schema))})))
|
|
req)))
|
|
|
|
(defn route-create-bulk-link! [uuid req]
|
|
(let [names (-> req :params :name)
|
|
instances (-> req :params :instances)
|
|
source-uuid (-> req :params :source-uuid)]
|
|
; (clojure.pprint/pprint names)
|
|
; (clojure.pprint/pprint instances)
|
|
; (clojure.pprint/pprint source-uuid)
|
|
#_(clojure.pprint/pprint
|
|
(map (fn [[target-schema target-instances]]
|
|
{:link-name (get names target-schema)
|
|
:instances target-instances})
|
|
instances)))
|
|
(resp/redirect (path :instance-show {:uuid uuid})))
|
|
|
|
(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
|
|
;; read routes with :schema-uuid
|
|
(wrap-routes
|
|
(compojure/routes
|
|
(GET (register! :instance-list "/instance/list/:schema-uuid")
|
|
[schema-uuid :as req]
|
|
(route-list! schema-uuid req)))
|
|
(middleware-schema/wrap-allowed-to-read!
|
|
schema-uuid-from-params))
|
|
(wrap-routes
|
|
(compojure/routes
|
|
(GET (register! :instance-show "/instance/:uuid")
|
|
[uuid :as req]
|
|
(route-show! uuid req)))
|
|
(middleware-schema/wrap-allowed-to-read!
|
|
schema-uuid-by-instance))
|
|
(wrap-routes
|
|
(compojure/routes
|
|
(POST (register! :instance-new "/instance/new") []
|
|
route-new!))
|
|
(middleware-schema/wrap-allowed-to-write!
|
|
schema-uuid-from-params))
|
|
linking-routes
|
|
writing-routes-with-uuid-in-path
|
|
(GET (register! :instance-list-starred "/instance/starred/list")
|
|
[:as req]
|
|
;; at some point someone will star an instance and then permissions to
|
|
;; the schema will be revoked
|
|
;; the instances will still be visible but can't be opened anymore
|
|
;; because of missing permissions, so they can't be unstared anymore
|
|
(route-list-starred! req)))
|