diff options
Diffstat (limited to 'users/grfn/bbbg/src')
31 files changed, 0 insertions, 2706 deletions
diff --git a/users/grfn/bbbg/src/bbbg/attendee.clj b/users/grfn/bbbg/src/bbbg/attendee.clj deleted file mode 100644 index 49a6d621de66..000000000000 --- a/users/grfn/bbbg/src/bbbg/attendee.clj +++ /dev/null @@ -1,10 +0,0 @@ -(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/grfn/bbbg/src/bbbg/attendee_check.clj b/users/grfn/bbbg/src/bbbg/attendee_check.clj deleted file mode 100644 index f34c41198e66..000000000000 --- a/users/grfn/bbbg/src/bbbg/attendee_check.clj +++ /dev/null @@ -1,4 +0,0 @@ -(ns bbbg.attendee-check - (:require [clojure.spec.alpha :as s])) - -(s/def ::id uuid?) diff --git a/users/grfn/bbbg/src/bbbg/core.clj b/users/grfn/bbbg/src/bbbg/core.clj deleted file mode 100644 index 632774d5cdac..000000000000 --- a/users/grfn/bbbg/src/bbbg/core.clj +++ /dev/null @@ -1,69 +0,0 @@ -(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/grfn/bbbg/src/bbbg/db.clj b/users/grfn/bbbg/src/bbbg/db.clj deleted file mode 100644 index 5bbf88925aa1..000000000000 --- a/users/grfn/bbbg/src/bbbg/db.clj +++ /dev/null @@ -1,366 +0,0 @@ -(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/grfn/bbbg/src/bbbg/db/attendee.clj b/users/grfn/bbbg/src/bbbg/db/attendee.clj deleted file mode 100644 index da5ee29321fb..000000000000 --- a/users/grfn/bbbg/src/bbbg/db/attendee.clj +++ /dev/null @@ -1,85 +0,0 @@ -(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/grfn/bbbg/src/bbbg/db/attendee_check.clj b/users/grfn/bbbg/src/bbbg/db/attendee_check.clj deleted file mode 100644 index 492f786bd660..000000000000 --- a/users/grfn/bbbg/src/bbbg/db/attendee_check.clj +++ /dev/null @@ -1,55 +0,0 @@ -(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/grfn/bbbg/src/bbbg/db/event.clj b/users/grfn/bbbg/src/bbbg/db/event.clj deleted file mode 100644 index 1b5a4e11ecd7..000000000000 --- a/users/grfn/bbbg/src/bbbg/db/event.clj +++ /dev/null @@ -1,94 +0,0 @@ -(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/grfn/bbbg/src/bbbg/db/event_attendee.clj b/users/grfn/bbbg/src/bbbg/db/event_attendee.clj deleted file mode 100644 index 31411e5d4504..000000000000 --- a/users/grfn/bbbg/src/bbbg/db/event_attendee.clj +++ /dev/null @@ -1,17 +0,0 @@ -(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/grfn/bbbg/src/bbbg/db/user.clj b/users/grfn/bbbg/src/bbbg/db/user.clj deleted file mode 100644 index 700105ef6350..000000000000 --- a/users/grfn/bbbg/src/bbbg/db/user.clj +++ /dev/null @@ -1,19 +0,0 @@ -(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/grfn/bbbg/src/bbbg/discord.clj b/users/grfn/bbbg/src/bbbg/discord.clj deleted file mode 100644 index e854ec1d147d..000000000000 --- a/users/grfn/bbbg/src/bbbg/discord.clj +++ /dev/null @@ -1,44 +0,0 @@ -(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/grfn/bbbg/src/bbbg/discord/auth.clj b/users/grfn/bbbg/src/bbbg/discord/auth.clj deleted file mode 100644 index 35bc580e3933..000000000000 --- a/users/grfn/bbbg/src/bbbg/discord/auth.clj +++ /dev/null @@ -1,90 +0,0 @@ -(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/grfn/bbbg/src/bbbg/event.clj b/users/grfn/bbbg/src/bbbg/event.clj deleted file mode 100644 index aa0578f3546b..000000000000 --- a/users/grfn/bbbg/src/bbbg/event.clj +++ /dev/null @@ -1,4 +0,0 @@ -(ns bbbg.event - (:require [clojure.spec.alpha :as s])) - -(s/def ::id uuid?) diff --git a/users/grfn/bbbg/src/bbbg/event_attendee.clj b/users/grfn/bbbg/src/bbbg/event_attendee.clj deleted file mode 100644 index 7b6b4c27648b..000000000000 --- a/users/grfn/bbbg/src/bbbg/event_attendee.clj +++ /dev/null @@ -1,6 +0,0 @@ -(ns bbbg.event-attendee - (:require [clojure.spec.alpha :as s])) - -(s/def ::attended? boolean?) - -(s/def ::rsvpd-attending? boolean?) diff --git a/users/grfn/bbbg/src/bbbg/handlers/attendee_checks.clj b/users/grfn/bbbg/src/bbbg/handlers/attendee_checks.clj deleted file mode 100644 index d7307c40673b..000000000000 --- a/users/grfn/bbbg/src/bbbg/handlers/attendee_checks.clj +++ /dev/null @@ -1,68 +0,0 @@ -(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/grfn/bbbg/src/bbbg/handlers/attendees.clj b/users/grfn/bbbg/src/bbbg/handlers/attendees.clj deleted file mode 100644 index ce84b88e97c1..000000000000 --- a/users/grfn/bbbg/src/bbbg/handlers/attendees.clj +++ /dev/null @@ -1,162 +0,0 @@ -(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/grfn/bbbg/src/bbbg/handlers/core.clj b/users/grfn/bbbg/src/bbbg/handlers/core.clj deleted file mode 100644 index caa679ee873f..000000000000 --- a/users/grfn/bbbg/src/bbbg/handlers/core.clj +++ /dev/null @@ -1,91 +0,0 @@ -(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/grfn/bbbg/src/bbbg/handlers/events.clj b/users/grfn/bbbg/src/bbbg/handlers/events.clj deleted file mode 100644 index 6f6d6f3585ae..000000000000 --- a/users/grfn/bbbg/src/bbbg/handlers/events.clj +++ /dev/null @@ -1,259 +0,0 @@ -(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/grfn/bbbg/src/bbbg/handlers/home.clj b/users/grfn/bbbg/src/bbbg/handlers/home.clj deleted file mode 100644 index 17d48755365c..000000000000 --- a/users/grfn/bbbg/src/bbbg/handlers/home.clj +++ /dev/null @@ -1,52 +0,0 @@ -(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/grfn/bbbg/src/bbbg/handlers/signup_form.clj b/users/grfn/bbbg/src/bbbg/handlers/signup_form.clj deleted file mode 100644 index ed1d7644f539..000000000000 --- a/users/grfn/bbbg/src/bbbg/handlers/signup_form.clj +++ /dev/null @@ -1,93 +0,0 @@ -(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/grfn/bbbg/src/bbbg/meetup/import.clj b/users/grfn/bbbg/src/bbbg/meetup/import.clj deleted file mode 100644 index d13d63e16cc2..000000000000 --- a/users/grfn/bbbg/src/bbbg/meetup/import.clj +++ /dev/null @@ -1,125 +0,0 @@ -(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/grfn/code/depot/users/grfn/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/grfn/bbbg/src/bbbg/meetup_user.clj b/users/grfn/bbbg/src/bbbg/meetup_user.clj deleted file mode 100644 index 945d681c6f82..000000000000 --- a/users/grfn/bbbg/src/bbbg/meetup_user.clj +++ /dev/null @@ -1,6 +0,0 @@ -(ns bbbg.meetup-user - (:require [clojure.spec.alpha :as s])) - -(s/def ::id - (s/nilable - (s/and string? seq))) diff --git a/users/grfn/bbbg/src/bbbg/styles.clj b/users/grfn/bbbg/src/bbbg/styles.clj deleted file mode 100644 index a860ae607626..000000000000 --- a/users/grfn/bbbg/src/bbbg/styles.clj +++ /dev/null @@ -1,407 +0,0 @@ -;; -*- 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/grfn/bbbg/src/bbbg/user.clj b/users/grfn/bbbg/src/bbbg/user.clj deleted file mode 100644 index f48c8d73388e..000000000000 --- a/users/grfn/bbbg/src/bbbg/user.clj +++ /dev/null @@ -1,8 +0,0 @@ -(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/grfn/bbbg/src/bbbg/util/core.clj b/users/grfn/bbbg/src/bbbg/util/core.clj deleted file mode 100644 index d458aa5592d2..000000000000 --- a/users/grfn/bbbg/src/bbbg/util/core.clj +++ /dev/null @@ -1,138 +0,0 @@ -(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/grfn/bbbg/src/bbbg/util/dev_secrets.clj b/users/grfn/bbbg/src/bbbg/util/dev_secrets.clj deleted file mode 100644 index 88f1b50caaa8..000000000000 --- a/users/grfn/bbbg/src/bbbg/util/dev_secrets.clj +++ /dev/null @@ -1,59 +0,0 @@ -(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/grfn/bbbg/src/bbbg/util/display.clj b/users/grfn/bbbg/src/bbbg/util/display.clj deleted file mode 100644 index 40716632a3c9..000000000000 --- a/users/grfn/bbbg/src/bbbg/util/display.clj +++ /dev/null @@ -1,23 +0,0 @@ -(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/grfn/bbbg/src/bbbg/util/spec.clj b/users/grfn/bbbg/src/bbbg/util/spec.clj deleted file mode 100644 index 89ac92669914..000000000000 --- a/users/grfn/bbbg/src/bbbg/util/spec.clj +++ /dev/null @@ -1,16 +0,0 @@ -(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/grfn/bbbg/src/bbbg/util/sql.clj b/users/grfn/bbbg/src/bbbg/util/sql.clj deleted file mode 100644 index 988959fd0603..000000000000 --- a/users/grfn/bbbg/src/bbbg/util/sql.clj +++ /dev/null @@ -1,5 +0,0 @@ -(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/grfn/bbbg/src/bbbg/util/time.clj b/users/grfn/bbbg/src/bbbg/util/time.clj deleted file mode 100644 index 0278f89f5edd..000000000000 --- a/users/grfn/bbbg/src/bbbg/util/time.clj +++ /dev/null @@ -1,152 +0,0 @@ -(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/grfn/bbbg/src/bbbg/views/flash.clj b/users/grfn/bbbg/src/bbbg/views/flash.clj deleted file mode 100644 index a44b21d4cb24..000000000000 --- a/users/grfn/bbbg/src/bbbg/views/flash.clj +++ /dev/null @@ -1,39 +0,0 @@ -(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/grfn/bbbg/src/bbbg/web.clj b/users/grfn/bbbg/src/bbbg/web.clj deleted file mode 100644 index f9755577a570..000000000000 --- a/users/grfn/bbbg/src/bbbg/web.clj +++ /dev/null @@ -1,140 +0,0 @@ -(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])) |