diff options
Diffstat (limited to 'users/aspen/bbbg/src/bbbg')
31 files changed, 2706 insertions, 0 deletions
diff --git a/users/aspen/bbbg/src/bbbg/attendee.clj b/users/aspen/bbbg/src/bbbg/attendee.clj new file mode 100644 index 0000000000..49a6d621de --- /dev/null +++ b/users/aspen/bbbg/src/bbbg/attendee.clj @@ -0,0 +1,10 @@ +(ns bbbg.attendee + (:require [clojure.spec.alpha :as s])) + +(s/def ::id uuid?) + +(s/def ::meetup-name (s/and string? seq)) + +(s/def ::discord-name (s/nilable string?)) + +(s/def ::organizer-notes string?) diff --git a/users/aspen/bbbg/src/bbbg/attendee_check.clj b/users/aspen/bbbg/src/bbbg/attendee_check.clj new file mode 100644 index 0000000000..f34c41198e --- /dev/null +++ b/users/aspen/bbbg/src/bbbg/attendee_check.clj @@ -0,0 +1,4 @@ +(ns bbbg.attendee-check + (:require [clojure.spec.alpha :as s])) + +(s/def ::id uuid?) diff --git a/users/aspen/bbbg/src/bbbg/core.clj b/users/aspen/bbbg/src/bbbg/core.clj new file mode 100644 index 0000000000..632774d5cd --- /dev/null +++ b/users/aspen/bbbg/src/bbbg/core.clj @@ -0,0 +1,69 @@ +(ns bbbg.core + (:gen-class) + (:require + [bbbg.db :as db] + [bbbg.web :as web] + [clojure.spec.alpha :as s] + [clojure.spec.test.alpha :as stest] + [com.stuartsierra.component :as component] + [expound.alpha :as exp])) + +(s/def ::config + (s/merge + ::db/config + ::web/config)) + +(defn make-system [config] + (component/system-map + :db (db/make-database config) + :web (web/make-server config))) + +(defn env->config [] + (s/assert + ::config + (merge + (db/env->config) + (web/env->config)))) + +(defn dev-config [] + (s/assert + ::config + (merge + (db/dev-config) + (web/dev-config)))) + +(defonce system nil) + +(defn init-dev [] + (s/check-asserts true) + (set! s/*explain-out* exp/printer) + (stest/instrument)) + +(defn run-dev [] + (init-dev) + (alter-var-root + #'system + (fn [sys] + (when sys + (component/start sys)) + (component/start (make-system (dev-config)))))) + +(defn -main [& _args] + (alter-var-root + #'system + (constantly (component/start (make-system (env->config)))))) + +(comment + ;; To run the application: + ;; 1. `M-x cider-jack-in` + ;; 2. `M-x cider-load-buffer` in this buffer + ;; 3. (optionally) configure the secrets backend in `bbbg.util.dev-secrets` + ;; 4. Put your cursor after the following form and run `M-x cider-eval-last-sexp` + ;; + ;; A web server will be listening on http://localhost:8888 + + (do + (run-dev) + (bbbg.db/migrate! (:db system))) + + ) diff --git a/users/aspen/bbbg/src/bbbg/db.clj b/users/aspen/bbbg/src/bbbg/db.clj new file mode 100644 index 0000000000..5bbf88925a --- /dev/null +++ b/users/aspen/bbbg/src/bbbg/db.clj @@ -0,0 +1,366 @@ +(ns bbbg.db + (:gen-class) + (:refer-clojure :exclude [get list count]) + (:require [camel-snake-kebab.core :as csk :refer [->kebab-case ->snake_case]] + [bbbg.util.core :as u] + [clojure.set :as set] + [clojure.spec.alpha :as s] + [clojure.string :as str] + [com.stuartsierra.component :as component] + [config.core :refer [env]] + [honeysql.format :as hformat] + [migratus.core :as migratus] + [next.jdbc :as jdbc] + [next.jdbc.connection :as jdbc.conn] + next.jdbc.date-time + [next.jdbc.optional :as jdbc.opt] + [next.jdbc.result-set :as rs] + [next.jdbc.sql :as sql]) + (:import [com.impossibl.postgres.jdbc PGSQLSimpleException] + com.zaxxer.hikari.HikariDataSource + [java.sql Connection ResultSet Types] + javax.sql.DataSource)) + +(s/def ::host string?) +(s/def ::database string?) +(s/def ::user string?) +(s/def ::password string?) + +(s/def ::config + (s/keys :opt [::host + ::database + ::user + ::password])) + +(s/fdef make-database + :args + (s/cat :config (s/keys :opt [::config]))) + +(s/fdef env->config :ret ::config) + +(s/def ::db any?) + +;;; + +(def default-config + (s/assert + ::config + {::host "localhost" + ::database "bbbg" + ::user "bbbg" + ::password "password"})) + +(defn dev-config [] default-config) + +(defn env->config [] + (->> + {::host (:pghost env) + ::database (:pgdatabase env) + ::user (:pguser env) + ::password (:pgpassword env)} + u/remove-nils + (s/assert ::config))) + +(defn ->db-spec [config] + (-> default-config + (merge config) + (set/rename-keys + {::host :host + ::database :dbname + ::user :username + ::password :password}) + (assoc :dbtype "pgsql"))) + +(defn connection + "Make a one-off connection from the given `::config` map, or the environment + if not provided" + ([] (connection (env->config))) + ([config] + (-> config + ->db-spec + (set/rename-keys {:username :user}) + jdbc/get-datasource + jdbc/get-connection))) + +(defrecord Database [config] + component/Lifecycle + (start [this] + (assoc this :pool (jdbc.conn/->pool HikariDataSource (->db-spec config)))) + (stop [this] + (some-> this :pool .close) + (dissoc this :pool)) + + clojure.lang.IFn + (invoke [this] (:pool this))) + +(defn make-database [config] + (map->Database {:config config})) + +(defn database? [x] + (or + (instance? Database x) + (and (map? x) (contains? x :pool)))) + +;;; +;;; Migrations +;;; + +(defn migratus-config + [db] + {:store :database + :migration-dir "migrations/" + :migration-table-name "__migrations__" + :db + (let [db (if (ifn? db) (db) db)] + (cond + (.isInstance Connection db) + {:connection db} + (.isInstance DataSource db) + {:datasource db} + :else (throw + (ex-info "migratus-config called with value of unrecognized type" + {:value db}))))}) + +(defn generate-migration + ([db name] (generate-migration db name :sql)) + ([db name type] (migratus/create (migratus-config db) name type))) + +(defn migrate! + [db] (migratus/migrate (migratus-config db))) + +(defn rollback! + [db] (migratus/rollback (migratus-config db))) + +;;; +;;; Database interaction +;;; + +(defn ->key-ns [tn] + (let [tn (name tn) + tn (if (str/starts-with? tn "public.") + (second (str/split tn #"\." 2)) + tn)] + (str "bbbg." (->kebab-case tn)))) + +(defn ->table-name [kns] + (let [kns (name kns)] + (->snake_case + (if (str/starts-with? kns "public.") + kns + (str "public." (last (str/split kns #"\."))))))) + +(defn ->column + ([col] (->column nil col)) + ([table col] + (let [col-table (some-> col namespace ->table-name) + snake-col (-> col name ->snake_case (str/replace #"\?$" ""))] + (if (or (not (namespace col)) + (not table) + (= (->table-name table) col-table)) + snake-col + ;; different table, assume fk + (str + (str/replace-first col-table "public." "") + "_" + snake-col))))) + +(defn ->value [v] + (if (keyword? v) + (-> v name csk/->snake_case_string) + v)) + +(defn process-key-map [table key-map] + (into {} + (map (fn [[k v]] [(->column table k) + (->value v)])) + key-map)) + +(defn fkize [col] + (if (str/ends-with? col "-id") + (let [table (str/join "-" (butlast (str/split (name col) #"-")))] + (keyword (->key-ns table) "id")) + col)) + +(def ^:private enum-members-cache (atom {})) +(defn- enum-members + "Returns a set of enum members as strings for the enum with the given name" + [db name] + (if-let [e (find @enum-members-cache name)] + (val e) + (let [r (try + (-> (jdbc/execute-one! + (db) + [(format "select enum_range(null::%s) as members" name)]) + :members + .getArray + set) + (catch PGSQLSimpleException _ + nil))] + (swap! enum-members-cache assoc name r) + r))) + +(def ^{:private true + :dynamic true} + *meta-db* + "Database connection to use to query metadata" + nil) + +(extend-protocol rs/ReadableColumn + String + (read-column-by-label [x _] x) + (read-column-by-index [x rsmeta idx] + (if-not *meta-db* + x + (let [typ (.getColumnTypeName rsmeta idx)] + ;; TODO: Is there a better way to figure out if a type is an enum? + (if (enum-members *meta-db* typ) + (keyword (csk/->kebab-case-string typ) + (csk/->kebab-case-string x)) + x))))) + +(comment + (->key-ns :public.user) + (->key-ns :public.api-token) + (->key-ns :api-token) + (->table-name :api-token) + (->table-name :public.user) + (->table-name :bbbg.user) + ) + +(defn as-fq-maps [^ResultSet rs _opts] + (let [qualify #(when (seq %) (str "bbbg." (->kebab-case %))) + rsmeta (.getMetaData rs) + cols (mapv + (fn [^Integer i] + (let [ty (.getColumnType rsmeta i) + lab (.getColumnLabel rsmeta i) + n (str (->kebab-case lab) + (when (= ty Types/BOOLEAN) "?"))] + (fkize + (if-let [q (some-> rsmeta (.getTableName i) qualify not-empty)] + (keyword q n) + (keyword n))))) + (range 1 (inc (.getColumnCount rsmeta))))] + (jdbc.opt/->MapResultSetOptionalBuilder rs rsmeta cols))) + +(def jdbc-opts + {:builder-fn as-fq-maps + :column-fn ->snake_case + :table-fn ->snake_case}) + +(defmethod hformat/fn-handler "count-distinct" [_ field] + (str "count(distinct " (hformat/to-sql field) ")")) + +(defn fetch + "Fetch a single row from the db matching the given `sql-map` or query" + [db sql-map & [opts]] + (s/assert + (s/nilable (s/keys)) + (binding [*meta-db* db] + (jdbc/execute-one! + (db) + (if (map? sql-map) + (hformat/format sql-map) + sql-map) + (merge jdbc-opts opts))))) + +(defn get + "Retrieve a single record from the given table by ID" + [db table id & [opts]] + (when id + (fetch + db + {:select [:*] + :from [table] + :where [:= :id id]} + opts))) + +(defn list + "Returns a list of rows from the db matching the given sql-map, table or + query" + [db sql-map-or-table & [opts]] + (s/assert + (s/coll-of (s/keys)) + (binding [*meta-db* db] + (jdbc/execute! + (db) + (cond + (map? sql-map-or-table) + (hformat/format sql-map-or-table) + (keyword? sql-map-or-table) + (hformat/format {:select [:*] :from [sql-map-or-table]}) + :else + sql-map-or-table) + (merge jdbc-opts opts))))) + +(defn count + [db sql-map] + (binding [*meta-db* db] + (:count + (fetch db {:select [[:%count.* :count]], :from [[sql-map :sq]]})))) + +(defn exists? + "Returns true if the given sql query-map would return any results" + [db sql-map] + (binding [*meta-db* db] + (pos? + (count db sql-map)))) + +(defn execute! + "Given a database and a honeysql query map, perform an operation on the + database and discard the results" + [db sql-map & [opts]] + (jdbc/execute! + (db) + (hformat/format sql-map) + (merge jdbc-opts opts))) + +(defn insert! + "Given a database, a table name, and a data hash map, inserts the + data as a single row in the database and attempts to return a map of generated + keys." + [db table key-map & [opts]] + (binding [*meta-db* db] + (sql/insert! + (db) + table + (process-key-map table key-map) + (merge jdbc-opts opts)))) + +(defn update! + "Given a database, a table name, a hash map of columns and values + to set, and a honeysql predicate, perform an update on the table. + Will " + [db table key-map where-params & [opts]] + (binding [*meta-db* db] + (execute! db + {:update table + :set (u/map-keys keyword (process-key-map table key-map)) + :where where-params + :returning [:id]} + opts))) + +(defn delete! + "Delete all rows from the given table matching the given where clause" + [db table where-clause] + (binding [*meta-db* db] + (sql/delete! (db) table (hformat/format-predicate where-clause)))) + +(defmacro with-transaction [[sym db opts] & body] + `(jdbc/with-transaction + [tx# (~db) ~opts] + (let [~sym (constantly tx#)] + ~@body))) + +(defn -main [& args] + (let [db (component/start (make-database (env->config)))] + (case (first args) + "migrate" (migrate! db) + "rollback" (rollback! db)))) + +(comment + (def db (:db bbbg.core/system)) + (generate-migration db "add-attendee-unique-meetup-id") + (migrate! db) + + ) diff --git a/users/aspen/bbbg/src/bbbg/db/attendee.clj b/users/aspen/bbbg/src/bbbg/db/attendee.clj new file mode 100644 index 0000000000..da5ee29321 --- /dev/null +++ b/users/aspen/bbbg/src/bbbg/db/attendee.clj @@ -0,0 +1,85 @@ +(ns bbbg.db.attendee + (:require + [bbbg.attendee :as attendee] + [bbbg.db :as db] + [bbbg.util.sql :refer [count-where]] + honeysql-postgres.helpers + [honeysql.helpers + :refer + [merge-group-by merge-join merge-left-join merge-select merge-where]] + [bbbg.util.core :as u])) + +(defn search + ([q] (search {:select [:attendee.*] :from [:attendee]} q)) + ([db-or-query q] + (if (db/database? db-or-query) + (db/list db-or-query (search q)) + (cond-> db-or-query + q (merge-where + [:or + [:ilike :meetup_name (str "%" q "%")] + [:ilike :discord_name (str "%" q "%")]])))) + ([db query q] + (db/list db (search query q)))) + +(defn for-event + ([event-id] + (for-event {:select [:attendee.*] + :from [:attendee]} + event-id)) + ([db-or-query event-id] + (if (db/database? db-or-query) + (db/list db-or-query (for-event event-id)) + (-> db-or-query + (merge-select :event-attendee.*) + (merge-join :event_attendee [:= :attendee.id :event_attendee.attendee_id]) + (merge-where [:= :event_attendee.event_id event-id])))) + ([db query event-id] + (db/list db (for-event query event-id)))) + +(defn with-stats + ([] (with-stats {:select [:attendee.*] + :from [:attendee]})) + ([query] + (-> query + (merge-left-join :event_attendee [:= :attendee.id :event_attendee.attendee_id]) + (merge-group-by :attendee.id) + (merge-select + [(count-where :event_attendee.rsvpd_attending) :events-rsvpd] + [(count-where :event_attendee.attended) :events-attended] + [(count-where [:and + :event_attendee.rsvpd_attending + [:not :event_attendee.attended]]) + :no-shows])))) + +(defn upsert-all! + [db attendees] + (when (seq attendees) + (db/list + db + {:insert-into :attendee + :values (map #(->> % + (db/process-key-map :attendee) + (u/map-keys keyword)) + attendees) + :upsert {:on-conflict [:meetup-user-id] + :do-update-set [:meetup-name]} + :returning [:id :meetup-user-id]}))) + +(comment + (def db (:db bbbg.core/system)) + (db/database? db) + (search db "gri") + (db/insert! db :attendee {::attendee/meetup-name "Griffin Smith" + ::attendee/discord-name "grfn" + }) + + (search db (with-stats) "gri") + + (search (with-stats) "gri") + + (db/list db (with-stats)) + + (db/insert! db :attendee {::attendee/meetup-name "Rando Guy" + ::attendee/discord-name "rando"}) + ) diff --git a/users/aspen/bbbg/src/bbbg/db/attendee_check.clj b/users/aspen/bbbg/src/bbbg/db/attendee_check.clj new file mode 100644 index 0000000000..492f786bd6 --- /dev/null +++ b/users/aspen/bbbg/src/bbbg/db/attendee_check.clj @@ -0,0 +1,55 @@ +(ns bbbg.db.attendee-check + (:require + [bbbg.attendee :as attendee] + [bbbg.attendee-check :as attendee-check] + [bbbg.db :as db] + [bbbg.user :as user] + [bbbg.util.core :as u])) + +(defn create! [db params] + (db/insert! db :attendee-check + (select-keys params [::attendee/id + ::user/id + ::attendee-check/last-dose-at]))) + +(defn attendees-with-last-checks + [db attendees] + (when (seq attendees) + (let [ids (map ::attendee/id attendees) + checks + (db/list db {:select [:attendee-check.*] + :from [:attendee-check] + :join [[{:select [:%max.attendee-check.checked-at + :attendee-check.attendee-id] + :from [:attendee-check] + :group-by [:attendee-check.attendee-id] + :where [:in :attendee-check.attendee-id ids]} + :last-check] + [:= + :attendee-check.attendee-id + :last-check.attendee-id]]}) + users (if (seq checks) + (u/key-by + ::user/id + (db/list db {:select [:public.user.*] + :from [:public.user] + :where [:in :id (map ::user/id checks)]})) + {}) + checks (map #(assoc % :user (users (::user/id %))) checks) + attendee-id->check (u/key-by ::attendee/id checks)] + (map #(assoc % :last-check (attendee-id->check (::attendee/id %))) + attendees)))) + +(comment + (def db (:db bbbg.core/system)) + + (attendees-with-last-checks + db + (db/list db :attendee) + ) + + (db/insert! db :attendee-check + {::attendee/id #uuid "58bcd372-ff6e-49df-b280-23d24c5ba0f0" + ::user/id #uuid "303fb606-5ef0-4682-ad7d-6429c670cd78" + ::attendee-check/last-dose-at "2021-12-19"}) + ) diff --git a/users/aspen/bbbg/src/bbbg/db/event.clj b/users/aspen/bbbg/src/bbbg/db/event.clj new file mode 100644 index 0000000000..1b5a4e11ec --- /dev/null +++ b/users/aspen/bbbg/src/bbbg/db/event.clj @@ -0,0 +1,94 @@ +(ns bbbg.db.event + (:require + [bbbg.attendee :as attendee] + [bbbg.db :as db] + [bbbg.event :as event] + [bbbg.util.sql :refer [count-where]] + [honeysql.helpers + :refer [merge-group-by merge-left-join merge-select merge-where]] + [java-time :refer [local-date local-date-time local-time]])) + +(defn create! [db event] + (db/insert! db :event (select-keys event [::event/date]))) + +(defn attended! + [db params] + (db/execute! + db + {:insert-into :event-attendee + :values [{:event_id (::event/id params) + :attendee_id (::attendee/id params) + :attended true}] + :upsert {:on-conflict [:event-id :attendee-id] + :do-update-set! {:attended true}}})) + +(defn on-day + ([day] {:select [:event.*] + :from [:event] + :where [:= :date (str day)]}) + ([db day] + (db/list db (on-day day)))) + + +(def end-of-day-hour + ;; 7am utc = 3am nyc + 7) + +(defn current-day + ([] (current-day (local-date-time))) + ([dt] + (if (<= 0 + (.getHour (local-time dt)) + end-of-day-hour) + (java-time/minus + (local-date dt) + (java-time/days 1)) + (local-date dt)))) + +(comment + (current-day + (local-date-time + 2022 5 1 + 1 13 0)) + ) + +(defn today + ([] (on-day (current-day))) + ([db] (db/list db (today)))) + +(defn upcoming + ([] (upcoming {:select [:event.*] :from [:event]})) + ([query] + (merge-where query [:>= :date (local-date)]))) + +(defn past + ([] (past {:select [:event.*] :from [:event]})) + ([query] + (merge-where query [:< :date (local-date)]))) + +(defn with-attendee-counts + [query] + (-> query + (merge-left-join :event_attendee [:= :event.id :event_attendee.event-id]) + (merge-select :%count.event_attendee.attendee_id) + (merge-group-by :event.id :event_attendee.event-id))) + +(defn with-stats + [query] + (-> query + (merge-left-join :event_attendee [:= :event.id :event_attendee.event-id]) + (merge-select + [(count-where :event-attendee.rsvpd_attending) :num-rsvps] + [(count-where :event-attendee.attended) :num-attendees]) + (merge-group-by :event.id))) + +(comment + (def db (:db bbbg.core/system)) + (db/list db (-> (today) (with-attendee-counts))) + + (honeysql.format/format + (honeysql-postgres.helpers/upsert {:insert-into :foo + :values {:bar 1}} + (-> (honeysql-postgres.helpers/on-conflict :did) + (honeysql-postgres.helpers/do-update-set! [:did true])))) + ) diff --git a/users/aspen/bbbg/src/bbbg/db/event_attendee.clj b/users/aspen/bbbg/src/bbbg/db/event_attendee.clj new file mode 100644 index 0000000000..31411e5d45 --- /dev/null +++ b/users/aspen/bbbg/src/bbbg/db/event_attendee.clj @@ -0,0 +1,17 @@ +(ns bbbg.db.event-attendee + (:require honeysql-postgres.format + [bbbg.db :as db] + [bbbg.util.core :as u])) + +(defn upsert-all! + [db attendees] + (when (seq attendees) + (db/execute! + db + {:insert-into :event-attendee + :values (map #(->> % + (db/process-key-map :event-attendee) + (u/map-keys keyword)) + attendees) + :upsert {:on-conflict [:event-id :attendee-id] + :do-update-set [:rsvpd-attending]}}))) diff --git a/users/aspen/bbbg/src/bbbg/db/user.clj b/users/aspen/bbbg/src/bbbg/db/user.clj new file mode 100644 index 0000000000..700105ef63 --- /dev/null +++ b/users/aspen/bbbg/src/bbbg/db/user.clj @@ -0,0 +1,19 @@ +(ns bbbg.db.user + (:require [bbbg.db :as db] + [bbbg.user :as user])) + +(defn create! [db attrs] + (db/insert! db + :public.user + (select-keys attrs [::user/id + ::user/username + ::user/discord-user-id]))) + +(defn find-or-create! [db attrs] + (or + (db/fetch db {:select [:*] + :from [:public.user] + :where [:= + :discord-user-id + (::user/discord-user-id attrs)]}) + (create! db attrs))) diff --git a/users/aspen/bbbg/src/bbbg/discord.clj b/users/aspen/bbbg/src/bbbg/discord.clj new file mode 100644 index 0000000000..e854ec1d14 --- /dev/null +++ b/users/aspen/bbbg/src/bbbg/discord.clj @@ -0,0 +1,44 @@ +(ns bbbg.discord + (:refer-clojure :exclude [get]) + (:require + [bbbg.util.dev-secrets :refer [secret]] + [clj-http.client :as http] + [clojure.string :as str])) + +(def base-uri "https://discord.com/api") + +(defn api-uri [path] + (str base-uri + (when-not (str/starts-with? path "/") "/") + path)) + +(defn get + ([token path] + (get token path {})) + ([token path params] + (:body + (http/get (api-uri path) + (-> params + (assoc :accept :json + :as :json) + (assoc-in [:headers "authorization"] + (str "Bearer " (:token token)))))))) + +(defn me [token] + (get token "/users/@me")) + +(defn guilds [token] + (get token "/users/@me/guilds")) + +(defn guild-member [token guild-id] + (get token (str "/users/@me/guilds/" guild-id "/member"))) + +(comment + (def token {:token (secret "bbbg/test-token")}) + (me token) + (guilds token) + (guild-member token "841295283564052510") + + (get token "/guilds/841295283564052510/roles") + + ) diff --git a/users/aspen/bbbg/src/bbbg/discord/auth.clj b/users/aspen/bbbg/src/bbbg/discord/auth.clj new file mode 100644 index 0000000000..35bc580e39 --- /dev/null +++ b/users/aspen/bbbg/src/bbbg/discord/auth.clj @@ -0,0 +1,90 @@ +(ns bbbg.discord.auth + (:require + [bbbg.discord :as discord] + [bbbg.util.core :as u] + [bbbg.util.dev-secrets :refer [secret]] + clj-time.coerce + [clojure.spec.alpha :as s] + [config.core :refer [env]] + [ring.middleware.oauth2 :refer [wrap-oauth2]])) + +(s/def ::client-id string?) +(s/def ::client-secret string?) +(s/def ::bbbg-guild-id string?) +(s/def ::bbbg-organizer-role string?) + +(s/def ::config (s/keys :req [::client-id + ::client-secret + ::bbbg-guild-id + ::bbbg-organizer-role])) + +;;; + +(defn env->config [] + (s/assert + ::config + {::client-id (:discord-client-id env) + ::client-secret (:discord-client-secret env) + ::bbbg-guild-id (:bbbg-guild-id env "841295283564052510") + ::bbbg-organizer-role (:bbbg-organizer-role + env + ;; TODO this might not be the right id + "908428000817725470")})) + +(defn dev-config [] + (s/assert + ::config + {::client-id (secret "bbbg/discord-client-id") + ::client-secret (secret "bbbg/discord-client-secret") + ::bbbg-guild-id "841295283564052510" + ::bbbg-organizer-role "908428000817725470"})) + +;;; + +(def access-token-url + "https://discord.com/api/oauth2/token") + +(def authorization-url + "https://discord.com/api/oauth2/authorize") + +(def revoke-url + "https://discord.com/api/oauth2/token/revoke") + +(def scopes ["guilds" + "guilds.members.read" + "identify"]) + +(defn discord-oauth-profile [{:keys [base-url] :as env}] + {:authorize-uri authorization-url + :access-token-uri access-token-url + :client-id (::client-id env) + :client-secret (::client-secret env) + :scopes scopes + :launch-uri "/auth/discord" + :redirect-uri (str base-url "/auth/discord/redirect") + :landing-uri (str base-url "/auth/success")}) + +(comment + (-> "https://bbbg-staging.gws.fyi/auth/login" + (java.net.URI/create) + (.resolve "https://bbbg.gws.fyi/auth/discord/redirect") + str) + ) + +(defn wrap-discord-auth [handler env] + (wrap-oauth2 handler {:discord (discord-oauth-profile env)})) + +(defn check-discord-auth + "Check that the user with the given token has the correct level of discord + auth" + [{::keys [bbbg-guild-id bbbg-organizer-role]} token] + (and (some (comp #{bbbg-guild-id} :id) + (discord/guilds token)) + (some #{bbbg-organizer-role} + (:roles (discord/guild-member token bbbg-guild-id))))) + +(comment + (#'ring.middleware.oauth2/valid-profile? + (discord-oauth-profile + (dev-config))) + ) diff --git a/users/aspen/bbbg/src/bbbg/event.clj b/users/aspen/bbbg/src/bbbg/event.clj new file mode 100644 index 0000000000..aa0578f354 --- /dev/null +++ b/users/aspen/bbbg/src/bbbg/event.clj @@ -0,0 +1,4 @@ +(ns bbbg.event + (:require [clojure.spec.alpha :as s])) + +(s/def ::id uuid?) diff --git a/users/aspen/bbbg/src/bbbg/event_attendee.clj b/users/aspen/bbbg/src/bbbg/event_attendee.clj new file mode 100644 index 0000000000..7b6b4c2764 --- /dev/null +++ b/users/aspen/bbbg/src/bbbg/event_attendee.clj @@ -0,0 +1,6 @@ +(ns bbbg.event-attendee + (:require [clojure.spec.alpha :as s])) + +(s/def ::attended? boolean?) + +(s/def ::rsvpd-attending? boolean?) diff --git a/users/aspen/bbbg/src/bbbg/handlers/attendee_checks.clj b/users/aspen/bbbg/src/bbbg/handlers/attendee_checks.clj new file mode 100644 index 0000000000..d7307c4067 --- /dev/null +++ b/users/aspen/bbbg/src/bbbg/handlers/attendee_checks.clj @@ -0,0 +1,68 @@ +(ns bbbg.handlers.attendee-checks + (:require + [bbbg.attendee :as attendee] + [bbbg.attendee-check :as attendee-check] + [bbbg.db :as db] + [bbbg.db.attendee-check :as db.attendee-check] + [bbbg.handlers.core :refer [page-response wrap-auth-required]] + [bbbg.user :as user] + [bbbg.util.display :refer [format-date]] + [compojure.coercions :refer [as-uuid]] + [compojure.core :refer [context GET POST]] + [ring.util.response :refer [not-found redirect]] + [bbbg.views.flash :as flash])) + +(defn- edit-attendee-checks-page [{:keys [existing-check] + attendee-id ::attendee/id}] + [:div.page + (when existing-check + [:p + "Already checked on " + (-> existing-check ::attendee-check/checked-at format-date) + " by " + (::user/username existing-check)]) + [:form.attendee-checks-form + {:method :post + :action (str "/attendees/" attendee-id "/checks")} + [:div.form-group + [:label + "Last Dose" + [:input {:type :date + :name :last-dose-at}]]] + [:div.form-group + [:input {:type :submit + :value "Mark Checked"}]]]]) + +(defn attendee-checks-routes [{:keys [db]}] + (wrap-auth-required + (context "/attendees/:attendee-id/checks" [attendee-id :<< as-uuid] + (GET "/edit" [] + (if (db/exists? db {:select [1] + :from [:attendee] + :where [:= :id attendee-id]}) + (let [existing-check (db/fetch + db + {:select [:attendee-check.* + :public.user.*] + :from [:attendee-check] + :join [:public.user + [:= + :attendee-check.user-id + :public.user.id]] + :where [:= :attendee-id attendee-id]})] + (page-response + (edit-attendee-checks-page + {:existing-check existing-check + ::attendee/id attendee-id}))) + (not-found "Attendee not found"))) + (POST "/" {{:keys [last-dose-at]} :params + {user-id ::user/id} :session} + (db.attendee-check/create! + db + {::attendee/id attendee-id + ::user/id user-id + ::attendee-check/last-dose-at last-dose-at}) + (-> (redirect "/attendees") + (flash/add-flash + #:flash{:type :success + :message "Successfully updated vaccination status"})))))) diff --git a/users/aspen/bbbg/src/bbbg/handlers/attendees.clj b/users/aspen/bbbg/src/bbbg/handlers/attendees.clj new file mode 100644 index 0000000000..ce84b88e97 --- /dev/null +++ b/users/aspen/bbbg/src/bbbg/handlers/attendees.clj @@ -0,0 +1,162 @@ +(ns bbbg.handlers.attendees + (:require + [bbbg.attendee :as attendee] + [bbbg.attendee-check :as attendee-check] + [bbbg.db :as db] + [bbbg.db.attendee :as db.attendee] + [bbbg.db.attendee-check :as db.attendee-check] + [bbbg.db.event :as db.event] + [bbbg.event :as event] + [bbbg.handlers.core :refer [page-response wrap-auth-required]] + [bbbg.user :as user] + [bbbg.util.display :refer [format-date]] + [bbbg.views.flash :as flash] + [cheshire.core :as json] + [compojure.coercions :refer [as-uuid]] + [compojure.core :refer [GET POST routes]] + [honeysql.helpers :refer [merge-where]] + [ring.util.response :refer [content-type not-found redirect response]]) + (:import + java.util.UUID)) + +(defn- attendees-page [{:keys [attendees q edit-notes]}] + [:div.page + [:form.search-form {:method :get :action "/attendees"} + [:input.search-input + {:type "search" + :name "q" + :value q + :title "Search Attendees"}] + [:input {:type "submit" + :value "Search Attendees"}]] + [:table.attendees + [:thead + [:tr + [:th "Meetup Name"] + [:th "Discord Name"] + [:th "Events RSVPd"] + [:th "Events Attended"] + [:th "No-Shows"] + [:th "Last Vaccination Check"] + [:th "Notes"]]] + [:tbody + (for [attendee (sort-by + (comp #{edit-notes} ::attendee/id) + (comp - compare) + attendees) + :let [id (::attendee/id attendee)]] + [:tr + [:td.attendee-name (::attendee/meetup-name attendee)] + [:td + [:label.mobile-label "Discord Name: "] + (or (not-empty (::attendee/discord-name attendee)) + "—")] + [:td + [:label.mobile-label "Events RSVPd: "] + (:events-rsvpd attendee)] + [:td + [:label.mobile-label "Events Attended: "] + (:events-attended attendee)] + [:td + [:label.mobile-label "No-shows: "] + (:no-shows attendee)] + [:td + [:label.mobile-label "Last Vaccination Check: "] + (if-let [last-check (:last-check attendee)] + (str "✔️ "(-> last-check + ::attendee-check/checked-at + format-date) + ", by " + (get-in last-check [:user ::user/username])) + (list + [:span {:title "Not Checked"} + "❌"] + " " + [:a {:href (str "/attendees/" id "/checks/edit")} + "Edit"] ))] + (if (= edit-notes id) + [:td + [:form.organizer-notes {:method :post + :action (str "/attendees/" id "/notes")} + [:div.form-group + [:input {:type :text :name "notes" + :value (::attendee/organizer-notes attendee) + :autofocus true}]] + [:div.form-group + [:input {:type "Submit" :value "Save Notes"}]]]] + [:td + [:p + (::attendee/organizer-notes attendee)] + [:p + [:a {:href (str "/attendees?edit-notes=" id)} + "Edit Notes"]]])])]]]) + +(defn attendees-routes [{:keys [db]}] + (routes + (wrap-auth-required + (routes + (GET "/attendees" [q edit-notes] + (let [attendees (db/list db (cond-> (db.attendee/with-stats) + q (db.attendee/search q))) + attendees (db.attendee-check/attendees-with-last-checks + db + attendees) + edit-notes (some-> edit-notes UUID/fromString)] + (page-response (attendees-page {:attendees attendees + :q q + :edit-notes edit-notes})))) + + (POST "/attendees/:id/notes" [id :<< as-uuid notes] + (if (seq (db/update! db + :attendee + {::attendee/organizer-notes notes} + [:= :id id])) + (-> (redirect "/attendees") + (flash/add-flash + #:flash{:type :success + :message "Notes updated successfully"})) + (not-found "Attendee not found"))))) + + (GET "/attendees.json" [q event_id attended] + (let [results + (db/list + db + (cond-> + (if q + (db.attendee/search q) + {:select [:attendee.*] :from [:attendee]}) + event_id (db.attendee/for-event event_id) + (some? attended) + (merge-where + (case attended + "true" :attended + "false" [:or [:= :attended nil] [:not :attended]]))))] + (-> {:results results} + json/generate-string + response + (content-type "application/json")))) + + (POST "/event_attendees" [event_id attendee_id] + (if (and (db/exists? db {:select [:id] :from [:event] :where [:= :id event_id]}) + (db/exists? db {:select [:id] :from [:attendee] :where [:= :id attendee_id]})) + (do + (db.event/attended! db {::event/id event_id + ::attendee/id attendee_id}) + (-> (redirect (str "/signup-forms/" event_id)) + (flash/add-flash + #:flash{:type :success + :message "Thank you for signing in! Enjoy the event."}))) + (response "Something went wrong"))))) + +(comment + (def db (:db bbbg.core/system)) + (db/list db :attendee) + (db/list db + (-> + (db.attendee/search "gr") + (db.attendee/for-event #uuid "9f4f3eae-3317-41a7-843c-81bcae52aebf"))) + (honeysql.format/format + (-> + (db.attendee/search "gr") + (db.attendee/for-event #uuid "9f4f3eae-3317-41a7-843c-81bcae52aebf"))) + ) diff --git a/users/aspen/bbbg/src/bbbg/handlers/core.clj b/users/aspen/bbbg/src/bbbg/handlers/core.clj new file mode 100644 index 0000000000..caa679ee87 --- /dev/null +++ b/users/aspen/bbbg/src/bbbg/handlers/core.clj @@ -0,0 +1,91 @@ +(ns bbbg.handlers.core + (:require + [bbbg.user :as user] + [bbbg.views.flash :as flash] + [hiccup.core :refer [html]] + [ring.util.response :refer [content-type response]] + [clojure.string :as str])) + +(def ^:dynamic *authenticated?* false) + +(defn authenticated? [request] + (some? (get-in request [:session ::user/id]))) + +(defn wrap-auth-required [handler] + (fn [req] + (when (authenticated? req) + (handler req)))) + +(defn wrap-dynamic-auth [handler] + (fn [req] + (binding [*authenticated?* (authenticated? req)] + (handler req)))) + +(def ^:dynamic *current-uri*) + +(defn wrap-current-uri [handler] + (fn [req] + (binding [*current-uri* (:uri req)] + (handler req)))) + +(defn nav-item [href label] + (let [active? + (when *current-uri* + (str/starts-with? + *current-uri* + href))] + [:li {:class (when active? "active")} + [:a {:href href} + label]])) + +(defn global-nav [] + [:nav.global-nav + [:ul + (nav-item "/events" "Events") + (when *authenticated?* + (nav-item "/attendees" "Attendees")) + [:li.spacer] + [:li + (if *authenticated?* + [:form.link-form + {:method :post + :action "/auth/sign-out"} + [:input {:type "submit" + :value "Sign Out"}]] + [:a {:href "/auth/discord"} + "Sign In"])]]]) + +(defn render-page [opts & body] + (let [[{:keys [title]} body] + (if (map? opts) + [opts body] + [{} (concat [opts] body)])] + (html + [:html {:lang "en"} + [:head + [:meta {:charset "UTF-8"}] + [:meta {:name "viewport" + :content "width=device-width,initial-scale=1"}] + [:title (if title + (str title " - BBBG") + "BBBG")] + [:link {:rel "stylesheet" + :type "text/css" + :href "/main.css"}]] + [:body + [:div.content + (global-nav) + #_(flash/render-flash flash/test-flash) + (flash/render-flash) + body] + [:script {:src "/main.js"}]]]))) + +(defn page-response [& render-page-args] + (-> (apply render-page render-page-args) + response + (content-type "text/html"))) + +(comment + (render-page + [:h1 "hi"]) + ) diff --git a/users/aspen/bbbg/src/bbbg/handlers/events.clj b/users/aspen/bbbg/src/bbbg/handlers/events.clj new file mode 100644 index 0000000000..6f6d6f3585 --- /dev/null +++ b/users/aspen/bbbg/src/bbbg/handlers/events.clj @@ -0,0 +1,259 @@ +(ns bbbg.handlers.events + (:require + [bbbg.db :as db] + [bbbg.db.attendee :as db.attendee] + [bbbg.db.event :as db.event] + [bbbg.event :as event] + [bbbg.handlers.core :refer [*authenticated?* page-response]] + [bbbg.meetup.import :refer [import-attendees!]] + [bbbg.util.display :refer [format-date pluralize]] + [bbbg.util.time :as t] + [bbbg.views.flash :as flash] + [compojure.coercions :refer [as-uuid]] + [compojure.core :refer [context GET POST]] + [java-time :refer [local-date]] + [ring.util.response :refer [not-found redirect]] + [bbbg.attendee :as attendee] + [bbbg.event-attendee :as event-attendee] + [bbbg.db.attendee-check :as db.attendee-check] + [bbbg.attendee-check :as attendee-check] + [bbbg.user :as user]) + (:import + java.time.format.FormatStyle)) + +(defn- num-attendees [event] + (str + (:num-attendees event) + (if (= (t/->LocalDate (::event/date event)) + (local-date)) + " Signed In" + (str " Attendee" (when-not (= 1 (:num-attendees event)) "s"))))) + +(def index-type->label + {:upcoming "Upcoming" + :past "Past"}) +(def other-index-type + {:upcoming :past + :past :upcoming}) + +(defn events-index + [{:keys [events num-events type]}] + [:div.page + [:div.page-header + [:h1 + (pluralize + num-events + (str (index-type->label type) " Event"))] + [:a {:href (str "/events" + (when (= :upcoming type) + "/past"))} + "View " + (index-type->label (other-index-type type)) + " Events"]] + (when *authenticated?* + [:a.button {:href "/events/new"} + "Create New Event"]) + [:ul.events-list + (for [event (sort-by + ::event/date + (comp - compare) + events)] + [:li + [:p + [:a {:href (str "/events/" (::event/id event))} + (format-date (::event/date event) + FormatStyle/FULL)]] + [:p + (pluralize (:num-rsvps event) "RSVP") + ", " + (num-attendees event)]])]]) + +(defn- import-attendee-list-form-group [] + [:div.form-group + [:label "Import Attendee List" + [:br] + [:input {:type :file + :name :attendees}]]]) + +(defn import-attendees-form [event] + [:form {:method :post + :action (str "/events/" (::event/id event) "/attendees") + :enctype "multipart/form-data"} + (import-attendee-list-form-group) + [:div.form-group + [:input {:type :submit + :value "Import"}]]]) + +(defn event-page [{:keys [event attendees]}] + [:div.page + [:div.page-header + [:h1 (format-date (::event/date event) + FormatStyle/FULL)] + [:div.spacer] + [:a.button {:href (str "/signup-forms/" (::event/id event) )} + "Go to Signup Form"] + [:form#delete-event + {:method :post + :action (str "/events/" (::event/id event) "/delete") + :data-confirm "Are you sure you want to delete this event?"} + [:input.error {:type "submit" + :value "Delete Event"}]]] + [:div.stats + [:p (pluralize (:num-rsvps event) "RSVP")] + [:p (num-attendees event)]] + [:div + (import-attendees-form event)] + [:div + [:table.attendees + [:thead + [:th "Meetup Name"] + [:th "Discord Name"] + [:th "RSVP"] + [:th "Signed In"] + [:th "Last Vaccination Check"]] + [:tbody + (for [attendee (sort-by (juxt (comp not ::event-attendee/rsvpd-attending?) + (comp not ::event-attendee/attended?) + (comp some? :last-check) + ::attendee/meetup-name) + attendees)] + [:tr + [:td.attendee-name (::attendee/meetup-name attendee)] + [:td + [:label.mobile-label "Discord Name: "] + (or (not-empty (::attendee/discord-name attendee)) + "—")] + [:td + [:label.mobile-label "RSVP: "] + (if (::event-attendee/rsvpd-attending? attendee) + [:span {:title "Yes"} "✔️"] + [:span {:title "No"} "❌"])] + [:td + [:label.mobile-label "Signed In: "] + (if (::event-attendee/attended? attendee) + [:span {:title "Yes"} "✔️"] + [:span {:title "No"} "❌"])] + [:td + [:label.mobile-label "Last Vaccination Check: "] + (if-let [last-check (:last-check attendee)] + (str "✔️ "(-> last-check + ::attendee-check/checked-at + format-date) + ", by " + (get-in last-check [:user ::user/username])) + (list + [:span {:title "Not Checked"} + "❌"] + " " + [:a {:href (str "/attendees/" + (::attendee/id attendee) + "/checks/edit")} + "Edit"]))]])]]]]) + +(defn import-attendees-page [{:keys [event]}] + [:div.page + [:h1 "Import Attendees for " (format-date (::event/date event))] + (import-attendees-form event)]) + +(defn event-form + ([] (event-form {})) + ([event] + [:div.page + [:div.page-header + [:h1 "Create New Event"]] + [:form {:method "POST" + :action "/events" + :enctype "multipart/form-data"} + [:div.form-group + [:label "Date" + [:input {:type "date" + :id "date" + :name "date" + :value (str (::event/date event))}]]] + (import-attendee-list-form-group) + [:div.form-group + [:input {:type "submit" + :value "Create Event"}]]]])) + +(defn- events-list-handler [db query type] + (let [events (db/list db (db.event/with-stats query)) + num-events (db/count db query)] + (page-response + (events-index {:events events + :num-events num-events + :type type})))) + +(defn events-routes [{:keys [db]}] + (context "/events" [] + (GET "/" [] + (events-list-handler db (db.event/upcoming) :upcoming)) + + (GET "/past" [] + (events-list-handler db (db.event/past) :past)) + + (GET "/new" [date] + (page-response + {:title "New Event"} + (event-form {::event/date date}))) + + (POST "/" [date attendees] + (let [event (db.event/create! db {::event/date date}) + message + (if attendees + (let [num-attendees + (import-attendees! db + (::event/id event) + (:tempfile attendees))] + (format "Event created with %d attendees" + num-attendees)) + "Event created")] + (-> (str "/signup-forms/" (::event/id event)) + redirect + (flash/add-flash {:flash/type :success + :flash/message message})))) + + (context "/:id" [id :<< as-uuid] + (GET "/" [] + (if-let [event (db/fetch db + (-> {:select [:event.*] + :from [:event] + :where [:= :event.id id]} + (db.event/with-stats)))] + (let [attendees (db.attendee-check/attendees-with-last-checks + db + (db/list db (db.attendee/for-event id)))] + (page-response + (event-page {:event event + :attendees attendees}))) + (not-found "Event Not Found"))) + + (POST "/delete" [] + (db/delete! db :event_attendee [:= :event-id id]) + (db/delete! db :event [:= :id id]) + (-> (redirect "/events") + (flash/add-flash + #:flash {:type :success + :message "Successfully deleted event"}))) + + (GET "/attendees/import" [] + (if-let [event (db/get db :event id)] + (page-response + (import-attendees-page {:event event})) + (not-found "Event Not Found"))) + + (POST "/attendees" [attendees] + (let [num-imported (import-attendees! db id (:tempfile attendees))] + (-> (redirect (str "/events/" id)) + (flash/add-flash + #:flash{:type :success + :message (format "Successfully imported %d attendees" + num-imported)}))))))) + +(comment + (def db (:db bbbg.core/system)) + + (-> (db/list db :event) + first + ::event/date + format-date) + ) diff --git a/users/aspen/bbbg/src/bbbg/handlers/home.clj b/users/aspen/bbbg/src/bbbg/handlers/home.clj new file mode 100644 index 0000000000..17d4875536 --- /dev/null +++ b/users/aspen/bbbg/src/bbbg/handlers/home.clj @@ -0,0 +1,52 @@ +(ns bbbg.handlers.home + (:require + [bbbg.db.user :as db.user] + [bbbg.discord.auth :as discord.auth] + [bbbg.handlers.core :refer [page-response authenticated?]] + [bbbg.user :as user] + [bbbg.views.flash :as flash] + [compojure.core :refer [GET POST routes]] + [ring.util.response :refer [redirect]] + [bbbg.discord :as discord])) + +(defn- home-page [] + [:div.home-page + [:a.signup-form-link {:href "/signup-forms"} + "Event Signup Form"]]) + +(defn auth-failure [] + [:div.auth-failure + [:p + "Sorry, only users with the Organizers role in discord can sign in"] + [:p + [:a {:href "/"} "Go Back"]]]) + +(defn home-routes [{:keys [db] :as env}] + (routes + (GET "/" [] (page-response (home-page))) + + (POST "/auth/sign-out" request + (if (authenticated? request) + (-> (redirect "/") + (update :session dissoc ::user/id) + (flash/add-flash + {:flash/message "Successfully Signed Out" + :flash/type :success})) + (redirect "/"))) + + (GET "/auth/success" request + (let [token (get-in request [:oauth2/access-tokens :discord])] + (if (discord.auth/check-discord-auth env token) + (let [discord-user (discord/me token) + user (db.user/find-or-create! + db + #::user{:username (:username discord-user) + :discord-user-id (:id discord-user)})] + (-> (redirect "/") + (assoc-in [:session ::user/id] (::user/id user)) + (flash/add-flash + {:flash/message "Successfully Signed In" + :flash/type :success}))) + (-> + (page-response (auth-failure)) + (assoc :status 401))))))) diff --git a/users/aspen/bbbg/src/bbbg/handlers/signup_form.clj b/users/aspen/bbbg/src/bbbg/handlers/signup_form.clj new file mode 100644 index 0000000000..ed1d7644f5 --- /dev/null +++ b/users/aspen/bbbg/src/bbbg/handlers/signup_form.clj @@ -0,0 +1,93 @@ +(ns bbbg.handlers.signup-form + (:require + [bbbg.attendee :as attendee] + [bbbg.db :as db] + [bbbg.db.attendee :as db.attendee] + [bbbg.db.event :as db.event] + [bbbg.event :as event] + [bbbg.handlers.core + :refer [*authenticated?* authenticated? page-response]] + [cheshire.core :as json] + [compojure.core :refer [context GET]] + [honeysql.helpers :refer [merge-where]] + [java-time :refer [local-date]] + [ring.util.response :refer [redirect]])) + +(defn no-events-page [{:keys [authenticated?]}] + [:div.page + [:p + "There are no events for today"] + (when authenticated? + [:p + [:a.button {:href (str "/events/new?date=" (str (local-date)))} + "Create New Event"]])]) + +(defn signup-page [{:keys [event attendees]}] + [:div.signup-page + [:form#signup-form + {:method "POST" + :action "/event_attendees" + :disabled "disabled"} + [:input#name-autocomplete + {:type "search" + :title "Name" + :name "name" + :spellcheck "false" + :autocorrect "off" + :autocomplete "off" + :autocapitalize "off" + :maxlength "2048"}] + [:input#attendee-id {:type "hidden" :name "attendee_id"}] + [:input#event-id {:type "hidden" :name "event_id" :value (::event/id event)}] + [:input#submit-button.hidden + {:type "submit" + :value "Sign In" + :disabled "disabled"}]] + [:ul#attendees-list + (if (seq attendees) + (for [attendee attendees] + [:li {:data-attendee (json/generate-string attendee) + :role "button"} + (::attendee/meetup-name attendee)]) + [:li.no-attendees + [:p + "Nobody has RSVPed to this event yet, or no attendee list has been + imported"] + (when *authenticated?* + [:p + [:a.button + {:href (str "/events/" + (::event/id event) + "/attendees/import")} + "Import Attendee List"]])])]]) + +(defn event-not-found [] + [:div.event-not-found + [:p "Event not found"] + [:p [:a {:href (str "/events/new")} "Create a new event"]]]) + +;;; + +(defn signup-form-routes [{:keys [db]}] + (context "/signup-forms" [] + (GET "/" request + (if-let [event (db/fetch db (db.event/today))] + (redirect (str "/signup-forms/" (::event/id event))) + (page-response (no-events-page + {:authenticated? (authenticated? request)})))) + + (GET "/:event-id" [event-id] + (if-let [event (db/get db :event event-id)] + (let [attendees (db/list db + (-> + (db.attendee/for-event event-id) + (merge-where + [:and + [:or + [:= :attended nil] + [:not :attended]] + :rsvpd_attending])))] + (page-response + (signup-page {:event event + :attendees attendees}))) + (event-not-found))))) diff --git a/users/aspen/bbbg/src/bbbg/meetup/import.clj b/users/aspen/bbbg/src/bbbg/meetup/import.clj new file mode 100644 index 0000000000..bbf8678976 --- /dev/null +++ b/users/aspen/bbbg/src/bbbg/meetup/import.clj @@ -0,0 +1,125 @@ +(ns bbbg.meetup.import + (:require + [bbbg.attendee :as attendee] + [bbbg.db.attendee :as db.attendee] + [bbbg.db.event-attendee :as db.event-attendee] + [bbbg.event :as event] + [bbbg.event-attendee :as event-attendee] + [bbbg.meetup-user :as meetup-user] + [bbbg.util.core :as u] + [bbbg.util.spec :as u.s] + [clojure.data.csv :as csv] + [clojure.java.io :as io] + [clojure.spec.alpha :as s] + [clojure.string :as str] + [expound.alpha :as exp])) + +(def spreadsheet-column->key + {"Name" :name + "User ID" :user-id + "Title" :title + "Event Host" :event-host + "RSVP" :rsvp + "Guests" :guests + "RSVPed on" :rsvped-on + "Joined Group on" :joined-group-on + "URL of Member Profile" :member-profile-url}) + +(defn read-attendees [f] + (with-open [reader (io/reader f)] + (let [[headers & rows] (-> reader (csv/read-csv :separator \tab)) + keys (map spreadsheet-column->key headers)] + (doall + (->> rows + (map (partial zipmap keys)) + (map (partial u/filter-kv (fn [k _] (some? k)))) + (filter (partial some (comp seq val)))))))) + +;;; + +(s/def ::imported-attendee + (s/keys :req [::attendee/meetup-name + ::meetup-user/id])) + +(def key->attendee-col + {:name ::attendee/meetup-name + :user-id ::meetup-user/id}) + +(defn row-user-id->user-id [row-id] + (str/replace-first row-id "user " "")) + +(defn check-attendee [attendee] + () + (if (s/valid? ::imported-attendee attendee) + attendee + (throw (ex-info + (str "Invalid imported attendee\n" + (exp/expound-str ::imported-attendee attendee)) + (assoc (s/explain-data ::imported-attendee attendee) + ::s/failure + ::s/assertion-failed))))) + +(defn row->attendee [r] + (u.s/assert! + ::imported-attendee + (update (u/keep-keys key->attendee-col r) + ::meetup-user/id row-user-id->user-id))) + +;;; + +(s/def ::imported-event-attendee + (s/keys :req [::event-attendee/rsvpd-attending? + ::attendee/id + ::event/id])) + +(def key->event-attendee-col + {:rsvp ::event-attendee/rsvpd-attending?}) + +(defn row->event-attendee + [{event-id ::event/id :keys [meetup-id->attendee-id]} r] + (let [attendee-id (-> r :user-id row-user-id->user-id meetup-id->attendee-id)] + (u.s/assert! + ::imported-event-attendee + (-> (u/keep-keys key->event-attendee-col r) + (update ::event-attendee/rsvpd-attending? + (partial = "Yes")) + (assoc ::event/id event-id + ::attendee/id attendee-id))))) + +;;; + +(defn import-attendees! [db event-id f] + (let [rows (read-attendees f) + attendees (db.attendee/upsert-all! db (map row->attendee rows)) + meetup-id->attendee-id (into {} + (map (juxt ::meetup-user/id ::attendee/id)) + attendees)] + (db.event-attendee/upsert-all! + db + (map (partial row->event-attendee + {::event/id event-id + :meetup-id->attendee-id meetup-id->attendee-id}) + rows)) + (count rows))) + +;;; Spreadsheet columns: +;;; +;;; Name +;;; User ID +;;; Title +;;; Event Host +;;; RSVP +;;; Guests +;;; RSVPed on +;;; Joined Group on +;;; URL of Member Profile +;;; Have you been to one of our events before? Note, attendance at all events will require proof of vaccination until further notice. + +(comment + (def -filename- "/home/aspen/code/depot/users/aspen/bbbg/sample-data.tsv") + (def event-id #uuid "09f8fed6-7480-451b-89a2-bb4edaeae657") + + (read-attendees -filename-) + (import-attendees! (:db bbbg.core/system) event-id -filename-) + + ) diff --git a/users/aspen/bbbg/src/bbbg/meetup_user.clj b/users/aspen/bbbg/src/bbbg/meetup_user.clj new file mode 100644 index 0000000000..945d681c6f --- /dev/null +++ b/users/aspen/bbbg/src/bbbg/meetup_user.clj @@ -0,0 +1,6 @@ +(ns bbbg.meetup-user + (:require [clojure.spec.alpha :as s])) + +(s/def ::id + (s/nilable + (s/and string? seq))) diff --git a/users/aspen/bbbg/src/bbbg/styles.clj b/users/aspen/bbbg/src/bbbg/styles.clj new file mode 100644 index 0000000000..a860ae6076 --- /dev/null +++ b/users/aspen/bbbg/src/bbbg/styles.clj @@ -0,0 +1,407 @@ +;; -*- eval: (rainbow-mode) -*- +(ns bbbg.styles + (:require + [garden.color :as color] + [garden.compiler :refer [compile-css]] + [garden.def :refer [defstyles]] + [garden.selectors + :refer [& active attr= descendant focus hover nth-child]] + [garden.stylesheet :refer [at-media]] + [garden.units :refer [px]])) + +(def black "#342e37") + +(def silver "#f9fafb") + +(def gray "#aaa") + +(def gray-light "#ddd") + +(def purple "#837aff") + +(def red "#c42348") + +(def orange "#fa824c") + +(def yellow "#FACB0F") + +(def blue "#026fb1") + +(def green "#87E24B") + +(def contextual-colors + {:success green + :info blue + :warning yellow + :error red}) + +;;; + +(def content-width (px 1200)) +(def mobile-width (px 480)) + +(defn desktop [& rules] + (at-media + {:screen true + :min-width content-width} + [:& rules])) + +(defn mobile [& rules] + (at-media + {:screen true + :max-width mobile-width} + [:& rules])) + +(defn not-mobile [& rules] + (at-media + {:screen true + :min-width mobile-width} + [:& rules])) + + +;;; + +(defstyles global-nav + [:.global-nav + {:background-color silver} + + [:>ul + {:display :flex + :flex-direction :row + :list-style :none} + + (desktop + {:width content-width + :margin "0 auto"})] + + [:a (descendant :.link-form (attr= "type" "submit")) + {:padding "1rem 1.5rem" + :display :block + :color black + :text-decoration :none} + + [(& hover) + {:color blue}]] + + [:li.active + {:font-weight "bold" + :border-bottom [["1px" "solid" black]]}]] + + [:.spacer + {:flex 1}]) + +(def link-conditional-styles + (list + [(& hover) (& active) + {:text-decoration :underline}] + [(& active) + {:color purple}])) + +(defstyles link-form + [:form.link-form + {:margin 0} + [(attr= "type" "submit") + {:background "none" + :border "none" + :padding 0 + :color blue + :text-decoration :none + :cursor :pointer} + link-conditional-styles]]) + +(defstyles search-form + [:.search-form + {:display :flex + :flex-direction :row + :width "100%"} + + [:>*+* + {:margin-left "0.75rem"}] + + [:input + {:flex 1}] + + [(attr= "type" "submit") + {:flex 0}]]) + +(defstyles forms + (let [text-input-types + #{"date" + "datetime-local" + "email" + "month" + "number" + "password" + "search" + "tel" + "text" + "time" + "url" + "week"} + each-text-type (fn [& rules] + (into + [] + (concat + (map (comp & (partial attr= "type")) + text-input-types) + rules)))] + (each-text-type + {:width "100%" + :display "block" + :padding "0.6rem 0.75rem" + :border [["1px" "solid" gray-light]] + :border-radius "3px" + :box-shadow [["inset" 0 "1px" "5px" "rgba(0,0,0,0.075)"]] + :transition "border-color 150ms" + :background "none"} + [(& focus) + {:outline "none" + :border-color purple}])) + + [(attr= "type" "submit") :button :.button + {:background-color (color/lighten blue 30) + :padding "0.6rem 0.75rem" + :border-radius "3px" + :border [[(px 1) "solid" (color/lighten blue 30)]] + :cursor :pointer + :display :inline-block} + + [(& hover) + {:border-color blue + :text-decoration :none + :box-shadow [[0 "1px" "5px" "rgba(0,0,0,0.075)"]]} + [(:a &) + {:text-decoration :none}]] + + [(& active) + {:background-color blue + :color :white + :box-shadow :none} + [(& :a) + {:text-decoration :none}]] + + (for [[context color] contextual-colors] + [(& (keyword (str "." (name context)))) + {:background-color (color/lighten color 30) + :border-color (color/lighten color 30) + :color black} + + [(& hover) + {:border-color color}]])] + + [:label + {:font-weight 600 + :width "100%"} + + [:input + {:font-weight "initial" + :margin-top "0.3rem"}]] + + [:.form-group + {:display :flex + :margin-bottom "0.8rem" + :flex-direction :column} + + [(attr= "type" "submit") + {:text-align :right + :align-self :flex-end}]]) + +(defstyles tables + [:table + {:width "100%" + :border-collapse "collapse"}] + + [:th + {:text-align "left"}] + + [:td :th + {:padding "0.75rem 1rem" + :border-spacing 0 + :border "none"}] + + [:tr + {:border-spacing 0 + :border "none"} + [(& (nth-child :even)) + {:background-color silver}]]) + +(defstyles flash + [:.flash-messages + {:max-width "800px" + :margin "1rem auto"} + + (at-media + {:screen true + :max-width "800px"} + [:& + {:margin-left "1rem" + :margin-right "1rem"}])] + + [:.flash-message + {:padding "1rem 1.5rem" + :border "1px solid" + :margin-bottom "1rem"}] + + (for [[context color] contextual-colors] + [(& (keyword (str ".flash-" (name context)))) + {:border-color color + :background-color (color/lighten color 30) + :border-radius "3px"}])) + +(defstyles home-page + [:.home-page + {:display :flex + :flex 1 + :justify-content :center + :align-items :center} + [:.signup-form-link + {:display :block + :border [["1px" :solid blue]] + :border-radius "3px" + :color black + :font-size "2rem" + :background-color (color/lighten blue 50) + :margin-left "auto" + :margin-right "auto" + :padding "2rem"} + (desktop + {:padding "5rem" + :margin-left 0 + :margin-right 0}) + [(& hover) (& active) + {:text-decoration :none}] + [(& active) + {:background-color (color/lighten blue 30)}]]]) + +(defstyles signup-page + [:.signup-page + {:margin "1rem"} + (desktop + {:width content-width + :margin "1rem auto"})] + + [:#signup-form + {:display :flex + :flex-direction :row + :width "100%"} + + [:* + {:flex 1}] + + [:*+* + {:margin-left "1rem"}] + + [(attr= "type" "submit") + {:flex 0}]] + + [:#attendees-list + {:list-style "none" + :overflow-y "auto" + :height "calc(100vh - 8.32425rem)"} + + [:li + {:padding "0.75rem 1rem" + :margin "0.35rem 0" + :border-radius "3px" + :background-color silver}]] + + [:.no-attendees + {:text-align "center" + :margin-top "6rem"} + + [:.button + {:margin-top "0.5rem"}]] + + [:.hidden + {:display :none}]) + +(defstyles attendees + [:.attendee-checks-form + {:max-width "340px" + :margin-left "auto" + :margin-right "auto"}] + + [:.attendees + (mobile + {:display :block} + + [:thead {:display :none}] + [:tbody :tr :td + {:display :block}] + + [:tr + {:background-color silver + :padding "0.5rem 0.8rem" + :margin-bottom "1rem" + :border-radius "3px"}] + [:td {:padding "0.2rem 0"}] + + [:.attendee-name + {:font-weight "bold" + :margin-bottom "0.9rem"}]) + + (not-mobile + [:.mobile-label + {:display :none}])]) + +(defstyles events + [:.events-list + {:margin-top "1rem"} + + [:li + {:margin-bottom "1rem"}]]) + +(defstyles styles + forms + tables + global-nav + link-form + search-form + flash + home-page + signup-page + attendees + events + + [:body + {:color black}] + + [:.content + {:display :flex + :flex-direction :column + :height "100%" + :width "100%"}] + + [:.page + {:margin-top "1rem" + :margin-left "1rem" + :margin-right "1rem"} + + (desktop + {:width content-width + :margin-left "auto" + :margin-right "auto"})] + + [:.page-header + {:display :flex + :flex-wrap :wrap + :padding-bottom "0.7rem" + :margin-bottom "1rem" + :border-bottom [["1px" "solid" silver]] + :align-items :center} + + [:*+* + {:margin-left "0.5rem"}] + + [:form + {:margin-block-end 0}]] + + [(attr= "role" "button") + {:cursor :pointer}] + + [:a {:color blue + :text-decoration :none} + link-conditional-styles]) + +(def stylesheet + (compile-css styles)) diff --git a/users/aspen/bbbg/src/bbbg/user.clj b/users/aspen/bbbg/src/bbbg/user.clj new file mode 100644 index 0000000000..f48c8d7338 --- /dev/null +++ b/users/aspen/bbbg/src/bbbg/user.clj @@ -0,0 +1,8 @@ +(ns bbbg.user + (:require [clojure.spec.alpha :as s])) + +(s/def ::id uuid?) + +(s/def ::discord-id string?) + +(s/def ::username string?) diff --git a/users/aspen/bbbg/src/bbbg/util/core.clj b/users/aspen/bbbg/src/bbbg/util/core.clj new file mode 100644 index 0000000000..d458aa5592 --- /dev/null +++ b/users/aspen/bbbg/src/bbbg/util/core.clj @@ -0,0 +1,138 @@ +(ns bbbg.util.core + (:require + [clojure.java.shell :refer [sh]] + [clojure.string :as str]) + (:import + java.util.UUID)) + +(defn remove-nils + "Remove all keys with nil values from m" + [m] + (let [!m (transient m)] + (doseq [[k v] m] + (when (nil? v) + (dissoc! !m k))) + (persistent! !m))) + + +(defn alongside + "Apply a pair of functions to the first and second element of a two element + vector, respectively. The two argument form partially applies, such that: + + ((alongside f g) xy) ≡ (alongside f g xy) + + This is equivalent to (***) in haskell's Control.Arrow" + ([f g] (partial alongside f g)) + ([f g [x y]] [(f x) (g y)])) + +(defn map-kv + "Map a pair of functions over the keys and values of a map, respectively. + Preserves metadata on the incoming map. + The two argument form returns a transducer that yields map-entries. + + (partial map-kv identity identity) ≡ identity" + ([kf vf] + (map (fn [[k v]] + ;; important to return a map-entry here so that callers down the road + ;; can use `key` or `val` + (first {(kf k) (vf v)})))) + ([kf vf m] + (into (empty m) (map-kv kf vf) m))) + +(defn filter-kv + "Returns a map containing the elements of m for which (f k v) returns logical + true. The one-argument form returns a transducer that yields map entries" + ([f] (filter (partial apply f))) + ([f m] + (into (empty m) (filter-kv f) m))) + +(defn map-keys + "Map f over the keys of m. Preserves metadata on the incoming map. The + one-argument form returns a transducer that yields map-entries." + ([f] (map-kv f identity)) + ([f m] (map-kv f identity m))) + +(defn keep-keys + "Map f over the keys of m, keeping only those entries for which f does not + return nil. Preserves metadata on the incoming map. The one-argument form + returns a transducer that yields map-entries." + ([f] (keep (fn [[k v]] (when-let [k' (f k)] + (first {k' v}))))) + ([f m] (into (empty m) (keep-keys f) m))) + +(defn map-vals + "Map f over the values of m. Preserves metadata on the incoming map. The + one-argument form returns a transducer that yields map-entries." + ([f] (map-kv identity f)) + ([f m] (map-kv identity f m))) + +(defn map-keys-recursive [f x] + (cond + (map? x) (map-kv f (partial map-keys-recursive f) x) + (sequential? x) (map (partial map-keys-recursive f) x) + :else x)) + +(defn denamespace [x] + (if (keyword? x) + (keyword (name x)) + (map-keys-recursive denamespace x))) + +(defn reverse-merge + "Like `clojure.core/merge`, except duplicate keys from maps earlier in the + argument list take precedence + + => (merge {:x 1} {:x 2}) + {:x 2} + + => (sut/reverse-merge {:x 1} {:x 2}) + {:x 1}" + [& ms] + (apply merge (reverse ms))) + +(defn invert-map + "Invert the keys and vals of m. Behavior with duplicate vals is undefined. + + => (sut/invert-map {:x 1 :y 2}) + {1 :x 2 :y}" + [m] + (into {} (map (comp vec reverse)) m)) + +(defn ->uuid + "Converts x to uuid, returning nil if x is nil or empty" + [x] + (cond + (not x) nil + (uuid? x) x + (and (string? x) (seq x)) + (UUID/fromString x))) + +(defn key-by + "Create a map from a seq obtaining keys via f + + => (sut/key-by :x [{:x 1} {:x 2 :y 3}]) + {1 {:x 1}, 2 {:x 2 :y 3}}" + [f l] + (into {} (map (juxt f identity)) l)) + +(defn distinct-by + "Like clojure.core/distinct, but can take a function f by which + distinctiveness is calculated" + [distinction-fn coll] + (let [step (fn step [xs seen] + (lazy-seq + ((fn [[f :as xs] seen] + (when-let [s (seq xs)] + (if (contains? seen (distinction-fn f)) + (recur (rest s) seen) + (cons f (step (rest s) (conj seen (distinction-fn f))))))) + xs seen)))] + (step coll #{}))) + +(defn pass [n] + (let [{:keys [exit out err]} (sh "pass" n)] + (if (= 0 exit) + (str/trim out) + (throw (Exception. + (format "`pass` command failed\nStandard output:%s\nStandard Error:%s" + out + err)))))) diff --git a/users/aspen/bbbg/src/bbbg/util/dev_secrets.clj b/users/aspen/bbbg/src/bbbg/util/dev_secrets.clj new file mode 100644 index 0000000000..88f1b50caa --- /dev/null +++ b/users/aspen/bbbg/src/bbbg/util/dev_secrets.clj @@ -0,0 +1,59 @@ +(ns bbbg.util.dev-secrets + "Utility library for loading secrets during development from multiple + backends. + + # Supported backends + + - [Pass][0] (the default) + + (bbbg.util.dev-secrets/set-backend! :pass) + + Loads all secrets by shelling out to `pass <secret-name>` + + [0]: https://www.passwordstore.org/ + + - Directory + + (bbbg.util.dev-secrets/set-backend! [:dir \"/path/to/secret/directory\"]) + + Loads all secrets by reading the secret name as a (plaintext!) file rooted + at the given directory" + (:require [bbbg.util.core :as u] + [clojure.string :as str] + [clojure.java.io :as io])) + +(def ^:dynamic *secret-backend* :pass) + +(defn set-backend! + "Change the default secret-backend" + [backend] + (alter-var-root #'*secret-backend* (constantly backend))) + +(defmulti ^:private load-secret + (fn [backend _secret] + (if (coll? backend) (first backend) backend))) + +(defmethod load-secret :pass [_ secret] + (u/pass secret)) + +(defmethod load-secret :dir [[_ dir] secret] + (str/trim (slurp (io/file dir secret)))) + +(defn secret + "Load the value for the given `secret-name' from the currently selected + backend" + [secret-name] + (load-secret *secret-backend* secret-name)) + +(comment + (secret "bbbg/discord-client-id") + + (binding [*secret-backend* [:dir "/tmp/bbbg-secrets"]] + (secret "bbbg/discord-client-id")) + + (set-backend! [:dir "/tmp/bbbg-secrets"]) + (secret "bbbg/discord-client-id") + + (set-backend! :pass) + (secret "bbbg/discord-client-id") + ) diff --git a/users/aspen/bbbg/src/bbbg/util/display.clj b/users/aspen/bbbg/src/bbbg/util/display.clj new file mode 100644 index 0000000000..40716632a3 --- /dev/null +++ b/users/aspen/bbbg/src/bbbg/util/display.clj @@ -0,0 +1,23 @@ +(ns bbbg.util.display + (:require + [bbbg.util.time :as t]) + (:import + [java.time.format DateTimeFormatter FormatStyle])) + +(defn format-date + ([d] (format-date d FormatStyle/MEDIUM)) + ([d ^FormatStyle format-style] + (let [formatter (DateTimeFormatter/ofLocalizedDate format-style)] + (.format (t/->LocalDate d) formatter)))) + +(defn pluralize + ([n sing plur] + (str (or n 0) " " (if (= 1 n) sing plur))) + ([n sing] + (pluralize n sing (str sing "s")))) + +(comment + (format-date #inst "2021-12-19T05:00:00.000-00:00") + (format-date #inst "2021-12-19T05:00:00.000-00:00" + FormatStyle/FULL) + ) diff --git a/users/aspen/bbbg/src/bbbg/util/spec.clj b/users/aspen/bbbg/src/bbbg/util/spec.clj new file mode 100644 index 0000000000..89ac926699 --- /dev/null +++ b/users/aspen/bbbg/src/bbbg/util/spec.clj @@ -0,0 +1,16 @@ +(ns bbbg.util.spec + (:require [expound.alpha :as exp] + [clojure.spec.alpha :as s])) + +(defn assert! + ([spec s] (assert! "Spec assertion failed" spec s)) + ([message spec x] + (if (s/valid? spec x) + x + (throw (ex-info + (str message + "\n" + (exp/expound-str spec x)) + (assoc (s/explain-data spec x) + ::s/failure + ::s/assertion-failed)))))) diff --git a/users/aspen/bbbg/src/bbbg/util/sql.clj b/users/aspen/bbbg/src/bbbg/util/sql.clj new file mode 100644 index 0000000000..988959fd06 --- /dev/null +++ b/users/aspen/bbbg/src/bbbg/util/sql.clj @@ -0,0 +1,5 @@ +(ns bbbg.util.sql + (:require [honeysql.core :as hsql])) + +(defn count-where [cond] + (hsql/call :count (hsql/call :case cond #sql/raw "1" :else nil))) diff --git a/users/aspen/bbbg/src/bbbg/util/time.clj b/users/aspen/bbbg/src/bbbg/util/time.clj new file mode 100644 index 0000000000..0278f89f5e --- /dev/null +++ b/users/aspen/bbbg/src/bbbg/util/time.clj @@ -0,0 +1,152 @@ +(ns bbbg.util.time + "Utilities for dealing with date/time" + (:require [clojure.spec.alpha :as s] + [clojure.test.check.generators :as gen] + [java-time :as jt]) + (:import [java.time + LocalDateTime LocalTime OffsetDateTime ZoneId ZoneOffset + LocalDate Year] + [java.time.format DateTimeFormatter DateTimeParseException] + java.util.Calendar + org.apache.commons.lang3.time.DurationFormatUtils)) + +(set! *warn-on-reflection* true) + +(defprotocol ToOffsetDateTime + (->OffsetDateTime [this] + "Coerces its argument to a `java.time.OffsetDateTime`")) + +(extend-protocol ToOffsetDateTime + OffsetDateTime + (->OffsetDateTime [odt] odt) + + java.util.Date + (->OffsetDateTime [d] + (-> d + .toInstant + (OffsetDateTime/ofInstant (ZoneId/of "UTC"))))) + +(defprotocol ToLocalTime (->LocalTime [this])) +(extend-protocol ToLocalTime + LocalTime + (->LocalTime [lt] lt) + + java.sql.Time + (->LocalTime [t] + (let [^Calendar cal (doto (Calendar/getInstance) + (.setTime t))] + (LocalTime/of + (.get cal Calendar/HOUR_OF_DAY) + (.get cal Calendar/MINUTE) + (.get cal Calendar/SECOND)))) + + java.util.Date + (->LocalTime [d] + (-> d .toInstant (LocalTime/ofInstant (ZoneId/of "UTC"))))) + +(defn local-time? [x] (satisfies? ToLocalTime x)) +(s/def ::local-time + (s/with-gen local-time? + #(gen/let [hour (gen/choose 0 23) + minute (gen/choose 0 59) + second (gen/choose 0 59) + nanos gen/nat] + (LocalTime/of hour minute second nanos)))) + +(defprotocol ToLocalDate (->LocalDate [this])) +(extend-protocol ToLocalDate + LocalDate + (->LocalDate [ld] ld) + + java.sql.Date + (->LocalDate [sd] (.toLocalDate sd)) + + java.util.Date + (->LocalDate [d] + (-> d .toInstant (LocalDate/ofInstant (ZoneId/of "UTC"))))) + +(defn local-date? [x] (satisfies? ToLocalDate x)) +(s/def ::local-date + (s/with-gen local-date? + #(gen/let [year (gen/choose Year/MIN_VALUE Year/MAX_VALUE) + day (gen/choose 1 (if (.isLeap (Year/of year)) + 366 + 365))] + (LocalDate/ofYearDay year day)))) + +(extend-protocol Inst + OffsetDateTime + (inst-ms* [zdt] + (inst-ms* (.toInstant zdt))) + + LocalDateTime + (inst-ms* [^LocalDateTime ldt] + (inst-ms* (.toInstant ldt ZoneOffset/UTC)))) + +(let [formatter DateTimeFormatter/ISO_OFFSET_DATE_TIME] + (defn ^OffsetDateTime parse-iso-8601 + "Parse s as an iso-8601 datetime, returning nil if invalid" + [^String s] + (try + (OffsetDateTime/parse s formatter) + (catch DateTimeParseException _ nil))) + + (defn format-iso-8601 + "Format dt, which can be an OffsetDateTime or java.util.Date, as iso-8601" + [dt] + (some->> dt ->OffsetDateTime (.format formatter)))) + +(let [formatter DateTimeFormatter/ISO_TIME] + (defn parse-iso-8601-time + "Parse s as an iso-8601 timestamp, returning nil if invalid" + [^String s] + (try + (LocalTime/parse s formatter) + (catch DateTimeParseException _ nil))) + + (defn format-iso-8601-time + "Format lt, which can be a LocalTime or java.sql.Time, as an iso-8601 + formatted timestamp without a date." + [lt] + (some->> lt ->LocalTime (.format formatter)))) + +(defmethod print-dup LocalTime [t w] + (binding [*out* w] + (print "#local-time ") + (print (str "\"" (format-iso-8601-time t) "\"")))) + +(defmethod print-method LocalTime [t w] + (print-dup t w)) + +(let [formatter DateTimeFormatter/ISO_LOCAL_DATE] + (defn parse-iso-8601-date + "Parse s as an iso-8601 date, returning nil if invalid" + [^String s] + (try + (LocalDate/parse s formatter) + (catch DateTimeParseException _ nil))) + + (defn format-iso-8601-date + "Format lt, which can be a LocalDate, as an iso-8601 formatted date without + a timestamp." + [lt] + (some->> lt ->LocalDate (.format formatter)))) + +(defmethod print-dup LocalDate [t w] + (binding [*out* w] + (print "#local-date ") + (print (str "\"" (format-iso-8601-date t) "\"")))) + +(defmethod print-method LocalDate [t w] + (print-dup t w)) + + +(defn ^String human-format-duration + "Human-format the given duration" + [^java.time.Duration dur] + (DurationFormatUtils/formatDurationWords (Math/abs (.toMillis dur)) true true)) + +(comment + (human-format-duration (jt/hours 5)) + (human-format-duration (jt/plus (jt/hours 5) (jt/minutes 7))) + ) diff --git a/users/aspen/bbbg/src/bbbg/views/flash.clj b/users/aspen/bbbg/src/bbbg/views/flash.clj new file mode 100644 index 0000000000..a44b21d4cb --- /dev/null +++ b/users/aspen/bbbg/src/bbbg/views/flash.clj @@ -0,0 +1,39 @@ +(ns bbbg.views.flash + (:require [clojure.spec.alpha :as s])) + +(s/def :flash/type #{:success :error :warning :info}) +(s/def :flash/message string?) +(s/def ::flash (s/keys :req [:flash/type :flash/message])) +(s/fdef add-flash :args (s/cat :resp map? :flash ::flash) :ret map?) + +;;; + +(def ^:dynamic *flash* nil) + +(defn wrap-page-flash [handler] + (fn + ([request] + (binding [*flash* (:flash request)] + (handler request))) + ([request respond raise] + (binding [*flash* (:flash request)] + (handler request respond raise))))) + +(defn add-flash [resp flash] + (update-in resp [:flash :flash/messages] conj flash)) + +(defn render-flash + ([] (render-flash *flash*)) + ([flash] + (when-some [messages (not-empty (:flash/messages flash))] + [:ul.flash-messages + (for [message messages] + [:li.flash-message + {:class (str "flash-" (-> message :flash/type name))} + (:flash/message message)])]))) + +(def test-flash + {:flash/messages + (for [type [:success :error :warning :info]] + {:flash/type type + :flash/message (str "Sample " type " message")})}) diff --git a/users/aspen/bbbg/src/bbbg/web.clj b/users/aspen/bbbg/src/bbbg/web.clj new file mode 100644 index 0000000000..f9755577a5 --- /dev/null +++ b/users/aspen/bbbg/src/bbbg/web.clj @@ -0,0 +1,140 @@ +(ns bbbg.web + (:require + [bbbg.discord.auth :as discord.auth :refer [wrap-discord-auth]] + [bbbg.handlers.attendee-checks :as attendee-checks] + [bbbg.handlers.attendees :as attendees] + [bbbg.handlers.core :refer [wrap-current-uri wrap-dynamic-auth]] + [bbbg.handlers.events :as events] + [bbbg.handlers.home :as home] + [bbbg.handlers.signup-form :as signup-form] + [bbbg.styles :refer [stylesheet]] + [bbbg.util.core :as u] + [bbbg.views.flash :refer [wrap-page-flash]] + [cambium.core :as log] + clj-time.coerce + [clojure.java.io :as io] + [clojure.spec.alpha :as s] + [com.stuartsierra.component :as component] + [compojure.core :refer [GET routes]] + [config.core :refer [env]] + [org.httpkit.server :as http-kit] + [ring.logger :refer [wrap-with-logger]] + [ring.middleware.flash :refer [wrap-flash]] + [ring.middleware.keyword-params :refer [wrap-keyword-params]] + [ring.middleware.multipart-params :refer [wrap-multipart-params]] + [ring.middleware.params :refer [wrap-params]] + [ring.middleware.resource :refer [wrap-resource]] + [ring.middleware.session :refer [wrap-session]] + [ring.middleware.session.cookie :refer [cookie-store]] + [ring.util.response :refer [content-type response]]) + (:import + java.util.Base64)) + +(s/def ::port pos-int?) + +(s/def ::cookie-secret + (s/and bytes? #(= 16 (count %)))) + +(s/def ::config + (s/merge + (s/keys :req [::port] + :opt [::cookie-secret + ::base-url]) + ::discord.auth/config)) + +(s/fdef make-server + :args (s/cat :config ::config)) + + +(defn- string->cookie-secret [raw] + (s/assert + ::cookie-secret + (when raw + (.decode (Base64/getDecoder) + (.getBytes raw "UTF-8"))))) + +(defn env->config [] + (s/assert + ::config + (u/remove-nils + (merge + {::port (:port env 8888) + ::cookie-secret (some-> env :cookie-secret string->cookie-secret) + ::base-url (:base-url env)} + (discord.auth/env->config))))) + +(defn dev-config [] + (s/assert + ::config + (merge + {::port 8888 + ::cookie-secret (into-array Byte/TYPE (repeat 16 0))} + (discord.auth/dev-config)))) + +;;; + +(defn app-routes [env] + (routes + (GET "/main.css" [] + (-> (response + (str + "\n/* begin base.css */\n" + (slurp (io/resource "base.css")) + "\n/* end base.css */\n" + stylesheet)) + (content-type "text/css"))) + + (attendees/attendees-routes env) + (attendee-checks/attendee-checks-routes env) + (signup-form/signup-form-routes env) + (events/events-routes env) + (home/home-routes env))) + +(defn middleware [app env] + (-> app + (wrap-resource "public") + (wrap-with-logger + {:log-fn + (fn [{:keys [level throwable message]}] + (log/log level {} throwable message))}) + wrap-current-uri + wrap-dynamic-auth + (wrap-discord-auth env) + wrap-keyword-params + wrap-multipart-params + wrap-params + wrap-page-flash + wrap-flash + (wrap-session {:store (cookie-store + {:key (:cookie-secret env) + :readers {'clj-time/date-time + clj-time.coerce/from-string}}) + :cookie-attrs {:same-site :lax}}))) + +(defn handler [env] + (-> (app-routes env) + (middleware env))) + +(defrecord WebServer [port cookie-secret db] + component/Lifecycle + (start [this] + (assoc this + ::shutdown-fn + (http-kit/run-server + (fn [r] ((handler this) r)) + {:port port}))) + (stop [this] + (if-let [shutdown-fn (::shutdown-fn this)] + (do (shutdown-fn :timeout 100) + (dissoc this ::shutdown-fn)) + this))) + +(defn make-server [{::keys [port cookie-secret] + :as env}] + (component/using + (map->WebServer + (merge + {:port port + :cookie-secret cookie-secret} + env)) + [:db])) |