Tactical commit before moving to Fletcher

I *think* I'm on the right lines with this, but illuminator is too slow
and the REPL server is timing out...
This commit is contained in:
Simon Brooke 2018-07-21 16:47:52 +01:00
parent d53c633527
commit 5ad384745f
10 changed files with 1034 additions and 939 deletions

View file

@ -54,7 +54,7 @@
:main ^:skip-aot youyesyet.core :main ^:skip-aot youyesyet.core
:migratus {:store :database :db ~(get (System/getenv) "DATABASE_URL")} :migratus {:store :database :db ~(get (System/getenv) "DATABASE_URL")}
:plugins [[lein-adl ["0.1.1"]] :plugins [;;[lein-adl ["0.1.1"]]
[lein-cljsbuild "1.1.4"] [lein-cljsbuild "1.1.4"]
[lein-codox "0.10.3"] [lein-codox "0.10.3"]
[lein-cprop "1.0.1"] [lein-cprop "1.0.1"]

View file

@ -5,7 +5,7 @@
-- --
-- auto-generated by [Application Description Language framework] -- auto-generated by [Application Description Language framework]
-- --
-- (https://github.com/simon-brooke/adl) at 20180721T111020.637Z -- (https://github.com/simon-brooke/adl) at 20180721T133846.002Z
-- --
-- A web-app intended to be used by canvassers -- A web-app intended to be used by canvassers
-- campaigning for a 'Yes' vote in the second independence -- campaigning for a 'Yes' vote in the second independence
@ -72,7 +72,7 @@ CREATE TABLE addresses
( (
id SERIAL NOT NULL PRIMARY KEY, id SERIAL NOT NULL PRIMARY KEY,
address VARCHAR(256) NOT NULL, address VARCHAR(256) NOT NULL,
postcode VARCHAR(16) CONSTRAINT pattern_7470 CHECK (postcode ~* '^([Gg][Ii][Rr] 0[Aa]{2})|((([A-Za-z][0-9]{1,2})|(([A-Za-z][A-Ha-hJ-Yj-y][0-9]{1,2})|(([AZa-z][0-9][A-Za-z])|([A-Za-z][A-Ha-hJ-Yj-y][0-9]?[A-Za-z]))))[0-9][A-Za-z]{2})$'), postcode VARCHAR(16) CONSTRAINT pattern_1 CHECK (postcode ~* '^([Gg][Ii][Rr] 0[Aa]{2})|((([A-Za-z][0-9]{1,2})|(([A-Za-z][A-Ha-hJ-Yj-y][0-9]{1,2})|(([AZa-z][0-9][A-Za-z])|([A-Za-z][A-Ha-hJ-Yj-y][0-9]?[A-Za-z]))))[0-9][A-Za-z]{2})$'),
phone VARCHAR(16), phone VARCHAR(16),
district_id INTEGER, district_id INTEGER,
latitude DOUBLE PRECISION, latitude DOUBLE PRECISION,
@ -985,31 +985,33 @@ ALTER TABLE ln_roles_canvassers_roles ADD CONSTRAINT ri_ln_roles_canvassers_role
ON DELETE NO ACTION ; ON DELETE NO ACTION ;
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- link table joining roles with canvassers -- link table joining events with teams
------------------------------------------------------------------------ ------------------------------------------------------------------------
CREATE TABLE ln_members_roles_canvassers CREATE TABLE ln_teams_events_teams
( (
role_id INTEGER, event_id INTEGER,
canvasser_id INTEGER team_id INTEGER
); );
GRANT SELECT ON ln_members_roles_canvassers TO admin, GRANT SELECT ON ln_teams_events_teams TO admin,
analysts, analysts,
canvassers, canvassers,
issueeditors, issueeditors,
issueexperts, issueexperts,
teamorganisers ; teamorganisers ;
GRANT INSERT ON ln_members_roles_canvassers TO admin ; GRANT INSERT ON ln_teams_events_teams TO admin,
GRANT UPDATE ON ln_members_roles_canvassers TO admin ; teamorganisers ;
GRANT DELETE ON ln_members_roles_canvassers TO admin ; GRANT UPDATE ON ln_teams_events_teams TO admin,
teamorganisers ;
GRANT DELETE ON ln_teams_events_teams TO admin ;
ALTER TABLE ln_members_roles_canvassers ADD CONSTRAINT ri_ln_members_roles_canvassers_canvassers_canvasser_id ALTER TABLE ln_teams_events_teams ADD CONSTRAINT ri_ln_teams_events_teams_events_event_id
FOREIGN KEY( canvasser_id ) FOREIGN KEY( event_id )
REFERENCES canvassers(id) REFERENCES events(id)
ON DELETE NO ACTION ; ON DELETE NO ACTION ;
ALTER TABLE ln_members_roles_canvassers ADD CONSTRAINT ri_ln_members_roles_canvassers_roles_role_id ALTER TABLE ln_teams_events_teams ADD CONSTRAINT ri_ln_teams_events_teams_teams_team_id
FOREIGN KEY( role_id ) FOREIGN KEY( team_id )
REFERENCES roles(id) REFERENCES teams(id)
ON DELETE NO ACTION ; ON DELETE NO ACTION ;
------------------------------------------------------------------------ ------------------------------------------------------------------------

View file

@ -63,6 +63,9 @@
<!-- content: put your main page content into this block --> <!-- content: put your main page content into this block -->
{% endblock %} {% endblock %}
</div> </div>
<p>
User: {{user}}
</p>
<br clear="both"/> <br clear="both"/>
</div> </div>
{% block foot %} {% block foot %}

View file

@ -39,28 +39,29 @@
(declare ^:dynamic *app-context*) (declare ^:dynamic *app-context*)
(def ^:dynamic *user* nil)
(parser/set-resource-path! (clojure.java.io/resource "templates")) (parser/set-resource-path! (clojure.java.io/resource "templates"))
(parser/add-tag! :csrf-field (fn [_ _] (anti-forgery-field))) (parser/add-tag! :csrf-field (fn [_ _] (anti-forgery-field)))
(filters/add-filter! :markdown (fn [content] [:safe (md-to-html-string content)])) (filters/add-filter! :markdown (fn [content] [:safe (md-to-html-string content)]))
(tags/add-tags) (tags/add-tags)
(defn raw-get-user-roles [user]
"Return, as a set, the names of the roles of which this user is a member."
(if
user
(do
(log/debug (str "seeking roles for user " user))
(let [roles
(set (map #(lower-case (:name %)) (db/list-roles-by-canvasser db/*db* user)))]
(log/debug (str "found roles " roles " for user " user))
roles))))
;; role assignments change only rarely. ;; role assignments change only rarely.
(def get-user-roles (memoize raw-get-user-roles)) (def get-user-roles
"Return, as a set, the names of the roles of which this `user` is a member."
(memoize
(fn [user]
(if
user
(do
(log/debug (str "seeking roles for user " user))
(let [roles
(set (map #(lower-case (:name %)) (db/list-roles-by-canvasser db/*db* user)))]
(log/debug (str "found roles " roles " for user " user))
roles))))))
(defn render (defn render-with-session
"renders the HTML `template` located relative to resources/templates in "renders the HTML `template` located relative to resources/templates in
the context of this session and with these parameters." the context of this session and with these parameters."
;; TODO: I'm passing `session` through into render. The default luminus ;; TODO: I'm passing `session` through into render. The default luminus
@ -68,7 +69,7 @@
;; than me so there's almost certainly a reason it doesn't. ;; than me so there's almost certainly a reason it doesn't.
[template session & [params]] [template session & [params]]
(let [user (:user session)] (let [user (:user session)]
(log/debug (str "layout/render: template: '" template "'")) (log/debug (str "layout/render-with-session: template: '" template "'"))
(content-type (content-type
(ok (ok
(parser/render-file (parser/render-file
@ -83,6 +84,26 @@
"text/html; charset=utf-8"))) "text/html; charset=utf-8")))
(defn render
"renders the HTML `template` located relative to resources/templates in
the context of this session and with these parameters."
[template & [params]]
(log/debug (str "layout/render: template: '" template "'"))
(content-type
(ok
(parser/render-file
template
(merge params
{:page template
:csrf-token *anti-forgery-token*
:user *user*
:user-roles (get-user-roles *user*)
:site-title (:site-title env)
:version (System/getProperty "youyesyet.version")})))
"text/html; charset=utf-8"))
(defn error-page (defn error-page
"error-details should be a map containing the following keys: "error-details should be a map containing the following keys:
:status - error status :status - error status

View file

@ -8,7 +8,7 @@
[ring-ttl-session.core :refer [ttl-memory-store]] [ring-ttl-session.core :refer [ttl-memory-store]]
[youyesyet.env :refer [defaults]] [youyesyet.env :refer [defaults]]
[youyesyet.config :refer [env]] [youyesyet.config :refer [env]]
[youyesyet.layout :refer [*app-context* error-page]]) [youyesyet.layout :refer [*app-context* *user* error-page]])
(:import [javax.servlet ServletContext])) (:import [javax.servlet ServletContext]))
@ -63,6 +63,17 @@
((if (:websocket? request) handler wrapped) request)))) ((if (:websocket? request) handler wrapped) request))))
(defn wrap-user
"Dynamically bind *user* to the user in the session, if any, so that it
is available in layout/render, q.v."
[handler]
(fn [request]
(if-let [user (-> request :session :user)]
(binding [*user* user]
(handler request))
(handler request))))
(defn wrap-base [handler] (defn wrap-base [handler]
(-> ((:middleware defaults) handler) (-> ((:middleware defaults) handler)
wrap-webjars wrap-webjars
@ -71,4 +82,6 @@
(assoc-in [:security :anti-forgery] false) (assoc-in [:security :anti-forgery] false)
(assoc-in [:session :store] (ttl-memory-store (* 60 30))))) (assoc-in [:session :store] (ttl-memory-store (* 60 30)))))
wrap-context wrap-context
wrap-internal-error)) wrap-internal-error
wrap-user))

View file

@ -49,7 +49,7 @@
(defn about-page [] (defn about-page []
(layout/render "about.html" {} {:title (layout/render "about.html" {:title
(str "About " (:site-title env)) (str "About " (:site-title env))
:motd (md-to-html-string (slurp (io/resource "about.md")))})) :motd (md-to-html-string (slurp (io/resource "about.md")))}))
@ -67,7 +67,7 @@
(defn home-page [] (defn home-page []
(layout/render "home.html" {} {:title "You yes yet?" (layout/render "home.html" {:title "You yes yet?"
:motd (md-to-html-string (motd))})) :motd (md-to-html-string (motd))}))
@ -100,13 +100,12 @@
(assoc (assoc
(response/found redirect-to) (response/found redirect-to)
:session :session
(assoc session :user user :roles roles))) (assoc session :user (assoc user :roles roles))))
;; if we've got a username but either no user object or else ;; if we've got a username but either no user object or else
;; the password doesn't match ;; the password doesn't match
username username
(layout/render (layout/render
"login.html" "login.html"
session
{:title (str "User " username " is unknown") {:title (str "User " username " is unknown")
:redirect-to redirect-to :redirect-to redirect-to
:warnings ["Your user name was not recognised or your password did not match"]}) :warnings ["Your user name was not recognised or your password did not match"]})
@ -114,7 +113,6 @@
true true
(layout/render (layout/render
"login.html" "login.html"
session
{:title "Please log in" {:title "Please log in"
:redirect-to redirect-to :redirect-to redirect-to
:authorities (db-core/list-authorities db-core/*db*)})))) :authorities (db-core/list-authorities db-core/*db*)}))))

View file

@ -42,7 +42,7 @@
(defn list-page [request] (defn list-page [request]
(layout/render (layout/render
"issue-expert/list.html" "issue-expert/list.html"
(:session request) ;; (:session request)
(let [user (:user (:session request))] (let [user (:user (:session request))]
{:title "Open requests" {:title "Open requests"
:user user :user user
@ -69,7 +69,7 @@
db/*db* {:id (:visit_id record)})))] db/*db* {:id (:visit_id record)})))]
(layout/render (layout/render
"issue-expert/request.html" "issue-expert/request.html"
(:session request) ;; (:session request)
{:title (str "Request from " (:name elector) " at " (:date visit)) {:title (str "Request from " (:name elector) " at " (:date visit))
:user (:user (:session request)) :user (:user (:session request))
:visit visit :visit visit

View file

@ -42,7 +42,6 @@
(defn app-page [request] (defn app-page [request]
(layout/render "app.html" (layout/render "app.html"
(:session request)
{:title "Canvasser app"})) {:title "Canvasser app"}))
@ -51,7 +50,7 @@
(let [record (-> request :session :user)] (let [record (-> request :session :user)]
(layout/render (layout/render
"auto/form-canvassers-Canvasser.html" "auto/form-canvassers-Canvasser.html"
(:session request) ;; (:session request)
{:title (str "Profile for " (-> request :session :user :fullname)) {:title (str "Profile for " (-> request :session :user :fullname))
:record record :record record
:elector_id :elector_id

View file

@ -19,14 +19,14 @@
"Render the routing page for the roles the currently logged in user is member of." "Render the routing page for the roles the currently logged in user is member of."
(let (let
[session (:session request) [session (:session request)
user (:user session) user (-> request :session :user)
roles (if roles (if
user user
(db-core/list-roles-by-canvasser db-core/*db* {:id (:id user)}))] (db-core/list-roles-by-canvasser db-core/*db* {:id (:id user)}))]
(log/info (str "Roles routing page; user is " user "; roles are " roles)) (log/info (str "Roles routing page; user is " user "; roles are " roles))
(cond (cond
roles (layout/render "roles.html" roles (layout/render "roles.html"
(:session request) ;; ;; (:session request)
{:title (str "Welcome " (:fullname user) ", what do you want to do?") {:title (str "Welcome " (:fullname user) ", what do you want to do?")
:user user :user user
:roles (map #(assoc % :link (safe-name (:name %) :sql)) roles)}) :roles (map #(assoc % :link (safe-name (:name %) :sql)) roles)})
@ -38,7 +38,7 @@
[request] [request]
(layout/render (layout/render
(support/resolve-template "application-index.html") (support/resolve-template "application-index.html")
(:session request) ;; (:session request)
{:title "Administrative menu"})) {:title "Administrative menu"}))
@ -49,18 +49,24 @@
[request] [request]
(layout/render (layout/render
(support/resolve-template "application-index.html") (support/resolve-template "application-index.html")
(:session request) ;; (:session request)
{:title "Administrative menu"})) {:title "Administrative menu"}))
(defn canvassers-page (defn canvassers-page
[request] [request]
(layout/render "roles/canvasser.html" (:session request) {})) (layout/render
"roles/canvasser.html"
;; (:session request)
{}))
(defn team-organisers-page (defn team-organisers-page
[request] [request]
(layout/render "roles/team-orgenisers.html" request {})) (layout/render
"roles/team-orgenisers.html"
;; request
{}))
(defroutes roles-routes (defroutes roles-routes

File diff suppressed because it is too large Load diff