chore(users): grfn -> aspen

Change-Id: I6c6847fac56f0a9a1a2209792e00a3aec5e672b9
Reviewed-on: https://cl.tvl.fyi/c/depot/+/10809
Autosubmit: aspen <root@gws.fyi>
Reviewed-by: sterni <sternenseemann@systemli.org>
Tested-by: BuildkiteCI
Reviewed-by: lukegb <lukegb@tvl.fyi>
This commit is contained in:
Aspen Smith 2024-02-11 22:00:40 -05:00 committed by clbot
parent 0ba476a426
commit 82ecd61f5c
478 changed files with 75 additions and 77 deletions

View file

@ -0,0 +1 @@
{:lint-as {garden.def/defstyles clojure.core/def}}

1
users/aspen/bbbg/.envrc Normal file
View file

@ -0,0 +1 @@
eval "$(lorri direnv)"

9
users/aspen/bbbg/.gitignore vendored Normal file
View file

@ -0,0 +1,9 @@
/target
/classes
*.jar
*.class
/.nrepl-port
/.cpcache
/.clojure
/result
/.clj-kondo/.cache

View file

@ -0,0 +1,2 @@
deps.nix: deps.edn
clj2nix ./deps.edn ./deps.nix '-A:uberjar' '-A:clj-test'

129
users/aspen/bbbg/README.md Normal file
View file

@ -0,0 +1,129 @@
# Brooklyn-Based Board Gaming signup sheet
This directory contains a small web application that acts as a signup
sheet and attendee tracking system for [my local board gaming
meetup](https://www.meetup.com/brooklyn-based-board-gaming/).
## Development
### Installing dependencies
#### With Nix + Docker ("blessed way")
Prerequisites:
- [Nix](https://nixos.org/)
- [lorri](https://github.com/nix-community/lorri)
- [Docker](https://www.docker.com/)
From this directory in a full checkout of depot, run the following
commands to install all development dependencies:
``` shell-session
$ pwd
/path/to/depot/users/aspen/bbbg
$ direnv allow
$ lorri watch --once # Wait for a single nix shell build
```
Then, to run a docker container with the development database:
``` shell-session
$ pwd
/path/to/depot/users/aspen/bbbg
$ arion up -d
```
#### Choose-your-own-adventure
Note that the **authoritative** source for dev dependencies is the `shell.nix`
file in this directory - those may diverge from what's written here; if so
follow those versions rather than these.
- Install the [clojure command-line
tools](https://clojure.org/guides/getting_started), with openjdk 11
- Install and run a postgresql 12 database, with:
- A user with superuser priveleges, the username `bbbg` and the
password `password`
- A database called `bbbg` owned by that user.
- Export the following environment variables in a context visible by
whatever method you use to run the application:
- `PGHOST=localhost`
- `PGUSER=bbbg`
- `PGDATABASE=bbbg`
- `PGPASSWORD=bbbg`
### Running the application
Before running the app, you'll need an oauth2 client-id and client secret for a
Discord app. The application can either load those from a
[pass](https://www.passwordstore.org/) password store, or read them from
plaintext files in a directory. In either case, they should be accessible at the
paths `bbbg/discord-client-id` and `bbbg/discord-client-secret` respectively.
#### From the command line
``` shell-session
$ clj -A:dev
Clojure 1.11.0-alpha3
user=> (require 'bbbg.core)
nil
user=> ;; Optionally, if you're using a directory with plaintext files for the discord client ID and client secret:
user=> (bbbg.util.dev-secrets/set-backend! [:dir "/path/to/that/directory"])
user=> (bbbg.core/run-dev)
##<SystemMap>
user=> (bbbg.db/migrate! (:db bbbg.core/system))
11:57:26.536 [main] INFO migratus.core - Starting migrations { }
11:57:26.538 [main] INFO com.zaxxer.hikari.HikariDataSource - HikariPool-1 - Starting... { }
11:57:26.883 [main] INFO com.zaxxer.hikari.pool.HikariPool - HikariPool-1 - Added connection com.impossibl.postgres.jdbc.PGDirectConnection@3cae770e { }
11:57:26.884 [main] INFO com.zaxxer.hikari.HikariDataSource - HikariPool-1 - Start completed. { }
11:57:26.923 [main] INFO migratus.core - Ending migrations { }
nil
```
This will run a web server for the application listening at
<http://localhost:8888>
#### In Emacs, with [CIDER](https://docs.cider.mx/cider/index.html) + [direnv](https://github.com/wbolster/emacs-direnv)
Open `//users/aspen/bbbg/src/bbbg/core.clj` in a buffer, then follow the
instructions at the end of the file
## Deployment
### With nix+terraform
Deployment configuration is located in the `tf.nix` file, which is
currently tightly coupled to my own infrastructure and AWS account but
could hypothetically be adjusted to be general-purpose.
To deploy a new version of the application, after following "installing
dependencies" above, run the following command in a context with ec2
credentials available:
``` shell-session
$ terraform apply
```
The current deploy configuration includes:
- An ec2 instance running nixos, with a postgresql database and the
bbbg application running as a service, behind nginx with an
auto-renewing letsencrypt cert
- The DNS A record for `bbbg.gws.fyi` pointing at that ec2 instance,
in the cloudflare zone for `gws.fyi`
### Otherwise
¯\\\_(ツ)_/¯
You'll need:
- An uberjar for bbbg; the canonical way of building that is `nix-build
/path/to/depot -A users.aspen.bbbg.server-jar` but I\'m not sure how that
works outside of nix
- A postgresql database
- Environment variables telling the app how to connect to that
database. See `config.systemd.services.bbbg-server.environment` in
`module.nix` for which env vars are currently being exported by the
NixOS module that runs the production version of the app

View file

@ -0,0 +1,15 @@
{ ... }:
{
services = {
postgres.service = {
image = "postgres:12";
environment = {
POSTGRES_DB = "bbbg";
POSTGRES_USER = "bbbg";
POSTGRES_PASSWORD = "password";
};
ports = [ "5432:5432" ];
};
};
}

View file

@ -0,0 +1,2 @@
let depot = import ../../.. { };
in depot.third_party.nixpkgs

View file

@ -0,0 +1,82 @@
args@{ depot, pkgs, ... }:
with pkgs.lib;
let
inherit (depot.third_party) gitignoreSource;
deps = import ./deps.nix {
inherit (pkgs) fetchMavenArtifact fetchgit lib;
};
in
rec {
meta.ci.targets = [
"db-util"
"server"
"tf"
];
depsPaths = deps.makePaths { };
resources = builtins.filterSource (_: type: type != "symlink") ./resources;
classpath.dev = concatStringsSep ":" (
(map gitignoreSource [ ./src ./test ./env/dev ]) ++ [ resources ] ++ depsPaths
);
classpath.test = concatStringsSep ":" (
(map gitignoreSource [ ./src ./test ./env/test ]) ++ [ resources ] ++ depsPaths
);
classpath.prod = concatStringsSep ":" (
(map gitignoreSource [ ./src ./env/prod ]) ++ [ resources ] ++ depsPaths
);
testClojure = pkgs.writeShellScript "test-clojure" ''
export HOME=$(pwd)
${pkgs.clojure}/bin/clojure -Scp ${depsPaths}
'';
mkJar = name: opts:
with pkgs;
assert (hasSuffix ".jar" name);
stdenv.mkDerivation rec {
inherit name;
dontUnpack = true;
buildPhase = ''
export HOME=$(pwd)
cp ${./pom.xml} pom.xml
cp ${./deps.edn} deps.edn
${clojure}/bin/clojure \
-Scp ${classpath.prod} \
-A:uberjar \
${name} \
-C ${opts}
'';
doCheck = true;
checkPhase = ''
echo "checking for existence of ${name}"
[ -f ${name} ]
'';
installPhase = ''
cp ${name} $out
'';
};
db-util-jar = mkJar "bbbg-db-util.jar" "-m bbbg.db";
db-util = pkgs.writeShellScriptBin "bbbg-db-util" ''
exec ${pkgs.openjdk17_headless}/bin/java -jar ${db-util-jar} "$@"
'';
server-jar = mkJar "bbbg-server.jar" "-m bbbg.core";
server = pkgs.writeShellScriptBin "bbbg-server" ''
exec ${pkgs.openjdk17_headless}/bin/java -jar ${server-jar} "$@"
'';
tf = import ./tf.nix args;
}

70
users/aspen/bbbg/deps.edn Normal file
View file

@ -0,0 +1,70 @@
{:deps
{org.clojure/clojure {:mvn/version "1.11.0-alpha3"}
;; DB
com.github.seancorfield/next.jdbc {:mvn/version "1.2.761"}
com.impossibl.pgjdbc-ng/pgjdbc-ng {:mvn/version "0.8.9"}
com.zaxxer/HikariCP {:mvn/version "5.0.0"}
migratus/migratus {:mvn/version "1.3.5"}
com.github.seancorfield/honeysql {:mvn/version "2.2.840"}
nilenso/honeysql-postgres {:mvn/version "0.4.112"}
;; HTTP
http-kit/http-kit {:mvn/version "2.5.3"}
ring/ring {:mvn/version "1.9.4"}
compojure/compojure {:mvn/version "1.6.2"}
javax.servlet/servlet-api {:mvn/version "2.5"}
ring-oauth2/ring-oauth2 {:mvn/version "0.2.0"}
clj-http/clj-http {:mvn/version "3.12.3"}
ring-logger/ring-logger {:mvn/version "1.0.1"}
;; Web
hiccup/hiccup {:mvn/version "1.0.5"}
garden/garden {:mvn/version "1.3.10"}
;; Logging + Observability
ch.qos.logback/logback-classic {:mvn/version "1.3.0-alpha12"}
org.slf4j/jul-to-slf4j {:mvn/version "2.0.0-alpha4"}
org.slf4j/jcl-over-slf4j {:mvn/version "2.0.0-alpha4"}
org.slf4j/log4j-over-slf4j {:mvn/version "2.0.0-alpha4"}
cambium/cambium.core {:mvn/version "1.1.1"}
cambium/cambium.codec-cheshire {:mvn/version "1.0.0"}
cambium/cambium.logback.core {:mvn/version "0.4.5"}
cambium/cambium.logback.json {:mvn/version "0.4.5"}
clj-commons/iapetos {:mvn/version "0.1.12"}
;; Utilities
com.stuartsierra/component {:mvn/version "1.0.0"}
yogthos/config {:mvn/version "1.1.9"}
clojure.java-time/clojure.java-time {:mvn/version "0.3.3"}
cheshire/cheshire {:mvn/version "5.10.1"}
org.apache.commons/commons-lang3 {:mvn/version "3.12.0"}
org.clojure/data.csv {:mvn/version "1.0.0"}
;; Spec
org.clojure/spec.alpha {:mvn/version "0.3.218"}
org.clojure/core.specs.alpha {:mvn/version "0.2.62"}
expound/expound {:mvn/version "0.8.10"}
org.clojure/test.check {:mvn/version "1.1.1"}}
:paths
["src"
"test"
"resources"
"target/classes"]
:aliases
{:dev {:extra-paths ["env/dev"]
:jvm-opts ["-XX:-OmitStackTraceInFastThrow"]}
:clj-test {:extra-paths ["test" "env/test"]
:extra-deps {io.github.cognitect-labs/test-runner
{:git/url "https://github.com/cognitect-labs/test-runner"
:sha "cc75980b43011773162b485f46f939dc5fba91e4"}}
:main-opts ["-m" "cognitect.test-runner"
"-d" "test"]}
:uberjar {:extra-deps {seancorfield/depstar {:mvn/version "1.0.94"}}
:extra-paths ["env/prod"]
:main-opts ["-m" "hf.depstar.uberjar"]}
:outdated {:extra-deps {com.github.liquidz/antq {:mvn/version "1.3.1"}}
:main-opts ["-m" "antq.core"]}}}

1494
users/aspen/bbbg/deps.nix Normal file

File diff suppressed because it is too large Load diff

View file

@ -0,0 +1,3 @@
(ns bbbg.env)
(def environment :env/dev)

15
users/aspen/bbbg/env/dev/logback.xml vendored Normal file
View file

@ -0,0 +1,15 @@
<?xml version="1.0" encoding="utf-8"?>
<configuration>
<appender name="STDOUT" class="ch.qos.logback.core.ConsoleAppender">
<encoder>
<pattern>%d{HH:mm:ss.SSS} [%thread] %-5level %logger{36} - %msg { %mdc }%n</pattern>
</encoder>
</appender>
<root level="INFO">
<appender-ref ref="STDOUT" />
</root>
<logger name="user" level="ALL" />
<logger name="ci.windtunnel" level="ALL" />
</configuration>

View file

@ -0,0 +1,3 @@
(ns bbbg.env)
(def environment :env/prod)

31
users/aspen/bbbg/env/prod/logback.xml vendored Normal file
View file

@ -0,0 +1,31 @@
<?xml version="1.0" encoding="utf-8"?>
<configuration>
<!-- Silence Logback's own status messages about config parsing -->
<statusListener class="ch.qos.logback.core.status.NopStatusListener" />
<!-- Console output -->
<appender name="STDOUT" class="ch.qos.logback.core.ConsoleAppender">
<!-- Only log level INFO and above -->
<filter class="ch.qos.logback.classic.filter.ThresholdFilter">
<level>INFO</level>
</filter>
<encoder class="ch.qos.logback.core.encoder.LayoutWrappingEncoder">
<layout class="cambium.logback.json.FlatJsonLayout">
<jsonFormatter class="ch.qos.logback.contrib.jackson.JacksonJsonFormatter">
<prettyPrint>false</prettyPrint>
</jsonFormatter>
<!-- <context>api</context> -->
<timestampFormat>yyyy-MM-dd'T'HH:mm:ss.SSS'Z'</timestampFormat>
<timestampFormatTimezoneId>UTC</timestampFormatTimezoneId>
<appendLineSeparator>true</appendLineSeparator>
</layout>
</encoder>
</appender>
<root level="INFO">
<appender-ref ref="STDOUT" />
</root>
<logger name="user" level="ALL" />
</configuration>

View file

@ -0,0 +1,3 @@
(ns bbbg.env)
(def environment :env/test)

11
users/aspen/bbbg/env/test/logback.xml vendored Normal file
View file

@ -0,0 +1,11 @@
<?xml version="1.0" encoding="utf-8"?>
<configuration>
<appender name="CONSOLE" class="ch.qos.logback.core.ConsoleAppender">
<encoder class="ch.qos.logback.classic.encoder.PatternLayoutEncoder">
<pattern>%msg%n</pattern>
</encoder>
</appender>
<root level="OFF">
<appender-ref ref="CONSOLE"/>
</root>
</configuration>

137
users/aspen/bbbg/module.nix Normal file
View file

@ -0,0 +1,137 @@
{ config, lib, pkgs, depot, ... }:
let
bbbg = depot.users.aspen.bbbg;
cfg = config.services.bbbg;
in
{
options = with lib; {
services.bbbg = {
enable = mkEnableOption "BBBG Server";
port = mkOption {
type = types.int;
default = 7222;
description = "Port to listen to for the HTTP server";
};
domain = mkOption {
type = types.str;
default = "bbbg.gws.fyi";
description = "Domain to host under";
};
proxy = {
enable = mkEnableOption "NGINX reverse proxy";
};
database = {
enable = mkEnableOption "BBBG Database Server";
user = mkOption {
type = types.str;
default = "bbbg";
description = "Database username";
};
host = mkOption {
type = types.str;
default = "localhost";
description = "Database host";
};
name = mkOption {
type = types.str;
default = "bbbg";
description = "Database name";
};
port = mkOption {
type = types.int;
default = 5432;
description = "Database host";
};
};
};
};
config = lib.mkMerge [
(lib.mkIf cfg.enable {
systemd.services.bbbg-server = {
wantedBy = [ "multi-user.target" ];
after = [ "network.target" ];
serviceConfig = {
DynamicUser = true;
Restart = "always";
EnvironmentFile = config.age.secretsDir + "/bbbg";
};
environment = {
PGHOST = cfg.database.host;
PGUSER = cfg.database.user;
PGDATABASE = cfg.database.name;
PORT = toString cfg.port;
BASE_URL = "https://${cfg.domain}";
};
script = "${bbbg.server}/bin/bbbg-server";
};
systemd.services.migrate-bbbg = {
description = "Run database migrations for BBBG";
wantedBy = [ "bbbg-server.service" ];
after = ([ "network.target" ]
++ (if cfg.database.enable
then [ "postgresql.service" ]
else [ ]));
serviceConfig = {
Type = "oneshot";
EnvironmentFile = config.age.secretsDir + "/bbbg";
};
environment = {
PGHOST = cfg.database.host;
PGUSER = cfg.database.user;
PGDATABASE = cfg.database.name;
};
script = "${bbbg.db-util}/bin/bbbg-db-util migrate";
};
})
(lib.mkIf cfg.database.enable {
services.postgresql = {
enable = true;
authentication = lib.mkForce ''
local all all trust
host all all 127.0.0.1/32 password
host all all ::1/128 password
hostnossl all all 127.0.0.1/32 password
hostnossl all all ::1/128 password
'';
ensureDatabases = [
cfg.database.name
];
ensureUsers = [{
name = cfg.database.user;
ensurePermissions = {
"DATABASE ${cfg.database.name}" = "ALL PRIVILEGES";
};
}];
};
})
(lib.mkIf cfg.proxy.enable {
services.nginx = {
enable = true;
virtualHosts."${cfg.domain}" = {
enableACME = true;
forceSSL = true;
locations."/".proxyPass = "http://localhost:${toString cfg.port}";
};
};
})
];
}

42
users/aspen/bbbg/pom.xml Normal file
View file

@ -0,0 +1,42 @@
<?xml version="1.0" encoding="utf-8"?>
<project xmlns="http://maven.apache.org/POM/4.0.0" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="http://maven.apache.org/POM/4.0.0 http://maven.apache.org/xsd/maven-4.0.0.xsd">
<modelVersion>4.0.0</modelVersion>
<groupId>fyi.gws</groupId>
<artifactId>bbbg</artifactId>
<version>0.1.0-SNAPSHOT</version>
<name>fyi.gws/bbbg</name>
<description>webhook listener for per-branch deploys</description>
<url>https://bbbg.gws.fyi</url>
<developers>
<developer>
<name>Griffin Smith</name>
</developer>
</developers>
<dependencies>
<dependency>
<groupId>org.clojure</groupId>
<artifactId>clojure</artifactId>
<version>1.11.0-alpha3</version>
</dependency>
</dependencies>
<build>
<sourceDirectory>src</sourceDirectory>
</build>
<repositories>
<repository>
<id>clojars</id>
<url>https://repo.clojars.org/</url>
</repository>
<repository>
<id>sonatype</id>
<url>https://oss.sonatype.org/content/repositories/snapshots/</url>
</repository>
</repositories>
<distributionManagement>
<repository>
<id>clojars</id>
<name>Clojars repository</name>
<url>https://clojars.org/repo</url>
</repository>
</distributionManagement>
</project>

View file

@ -0,0 +1,152 @@
/* montserrat-italic - latin */
@font-face {
font-family: "Montserrat";
font-style: italic;
font-weight: 400;
src: local("Montserrat Italic"), local("Montserrat-Italic"),
url("/fonts/montserrat-v15-latin-italic.woff2") format("woff2"),
/* Chrome 26+, Opera 23+, Firefox 39+ */
url("/fonts/montserrat-v15-latin-italic.woff") format("woff"); /* Chrome 6+, Firefox 3.6+, IE 9+, Safari 5.1+ */
}
/* montserrat-regular - latin */
@font-face {
font-family: "Montserrat";
font-style: normal;
font-weight: 400;
src: local("Montserrat Regular"), local("Montserrat-Regular"),
url("/fonts/montserrat-v15-latin-regular.woff2") format("woff2"),
/* Chrome 26+, Opera 23+, Firefox 39+ */
url("/fonts/montserrat-v15-latin-regular.woff") format("woff"); /* Chrome 6+, Firefox 3.6+, IE 9+, Safari 5.1+ */
}
/* montserrat-500 - latin */
@font-face {
font-family: "Montserrat";
font-style: normal;
font-weight: 500;
src: local("Montserrat Medium"), local("Montserrat-Medium"),
url("/fonts/montserrat-v15-latin-500.woff2") format("woff2"),
/* Chrome 26+, Opera 23+, Firefox 39+ */
url("/fonts/montserrat-v15-latin-500.woff") format("woff"); /* Chrome 6+, Firefox 3.6+, IE 9+, Safari 5.1+ */
}
/* montserrat-500italic - latin */
@font-face {
font-family: "Montserrat";
font-style: italic;
font-weight: 500;
src: local("Montserrat Medium Italic"), local("Montserrat-MediumItalic"),
url("/fonts/montserrat-v15-latin-500italic.woff2") format("woff2"),
/* Chrome 26+, Opera 23+, Firefox 39+ */
url("/fonts/montserrat-v15-latin-500italic.woff") format("woff"); /* Chrome 6+, Firefox 3.6+, IE 9+, Safari 5.1+ */
}
/* montserrat-600 - latin */
@font-face {
font-family: "Montserrat";
font-style: normal;
font-weight: 600;
src: local("Montserrat SemiBold"), local("Montserrat-SemiBold"),
url("/fonts/montserrat-v15-latin-600.woff2") format("woff2"),
/* Chrome 26+, Opera 23+, Firefox 39+ */
url("/fonts/montserrat-v15-latin-600.woff") format("woff"); /* Chrome 6+, Firefox 3.6+, IE 9+, Safari 5.1+ */
}
/* montserrat-800 - latin */
@font-face {
font-family: "Montserrat";
font-style: normal;
font-weight: 800;
src: local("Montserrat ExtraBold"), local("Montserrat-ExtraBold"),
url("/fonts/montserrat-v15-latin-800.woff2") format("woff2"),
/* Chrome 26+, Opera 23+, Firefox 39+ */
url("/fonts/montserrat-v15-latin-800.woff") format("woff"); /* Chrome 6+, Firefox 3.6+, IE 9+, Safari 5.1+ */
}
/* montserrat-800italic - latin */
@font-face {
font-family: "Montserrat";
font-style: italic;
font-weight: 800;
src: local("Montserrat ExtraBold Italic"), local("Montserrat-ExtraBoldItalic"),
url("/fonts/montserrat-v15-latin-800italic.woff2") format("woff2"),
/* Chrome 26+, Opera 23+, Firefox 39+ */
url("/fonts/montserrat-v15-latin-800italic.woff") format("woff"); /* Chrome 6+, Firefox 3.6+, IE 9+, Safari 5.1+ */
}
body {
width: 100%;
font-family: "Montserrat", Helvetica, sans-serif;
margin: 0;
box-sizing: border-box;
}
*,
::before,
::after {
box-sizing: border-box;
}
ul,
ol {
padding: 0;
}
body,
h1,
h2,
h3,
h4,
p,
ul,
ol,
li,
figure,
figcaption,
blockquote,
dl,
dd {
margin: 0;
}
body {
min-height: 100vh;
scroll-behavior: smooth;
text-rendering: optimizeSpeed;
line-height: 1.5;
}
ul[class],
ol[class] {
list-style: none;
}
a:not([class]) {
text-decoration-skip-ink: auto;
}
img {
max-width: 100%;
display: block;
}
article > * + * {
margin-top: 1em;
}
input,
button,
textarea,
select {
font: inherit;
}
@media (prefers-reduced-motion: reduce) {
* {
animation-duration: 0.01ms !important;
animation-iteration-count: 1 !important;
transition-duration: 0.01ms !important;
scroll-behavior: auto !important;
}
}

View file

@ -0,0 +1,14 @@
drop table "public"."user";
-- ;;
drop table "public"."event_attendee";
-- ;;
drop table "public"."event";
-- ;;
drop table "public"."attendee";

View file

@ -0,0 +1,32 @@
CREATE EXTENSION IF NOT EXISTS "uuid-ossp";
-- ;;
CREATE TABLE "attendee" (
"id" UUID PRIMARY KEY NOT NULL DEFAULT uuid_generate_v4(),
"meetup_name" TEXT NOT NULL,
"discord_name" TEXT,
"meetup_user_id" TEXT,
"organizer_notes" TEXT NOT NULL DEFAULT '',
"created_at" TIMESTAMP WITHOUT TIME ZONE NOT NULL DEFAULT now()
);
-- ;;
CREATE TABLE "event" (
"id" UUID PRIMARY KEY NOT NULL DEFAULT uuid_generate_v4(),
"date" DATE NOT NULL,
"created_at" TIMESTAMP WITHOUT TIME ZONE NOT NULL DEFAULT now()
);
-- ;;
CREATE TABLE "event_attendee" (
"event_id" UUID NOT NULL REFERENCES "event" ("id"),
"attendee_id" UUID NOT NULL REFERENCES "attendee" ("id"),
"rsvpd_attending" BOOL,
"attended" BOOL,
"created_at" TIMESTAMP WITHOUT TIME ZONE NOT NULL DEFAULT now(),
PRIMARY KEY ("event_id", "attendee_id")
);
-- ;;
CREATE TABLE "user" (
"id" UUID PRIMARY KEY NOT NULL DEFAULT uuid_generate_v4(),
"username" TEXT NOT NULL,
"discord_user_id" TEXT NOT NULL,
"created_at" TIMESTAMP WITHOUT TIME ZONE NOT NULL DEFAULT now()
);

View file

@ -0,0 +1 @@
DROP TABLE "attendee_check";

View file

@ -0,0 +1,7 @@
CREATE TABLE attendee_check (
"id" UUID PRIMARY KEY NOT NULL DEFAULT uuid_generate_v4(),
"attendee_id" UUID NOT NULL REFERENCES attendee ("id"),
"user_id" UUID NOT NULL REFERENCES "public"."user" ("id"),
"last_dose_at" DATE,
"checked_at" TIMESTAMP WITHOUT TIME ZONE NOT NULL DEFAULT now()
);

View file

@ -0,0 +1 @@
drop index attendee_uniq_meetup_user_id;

View file

@ -0,0 +1,2 @@
create unique index "attendee_uniq_meetup_user_id" on attendee (meetup_user_id);
-- ;;

View file

@ -0,0 +1,73 @@
window.onload = () => {
const input = document.getElementById("name-autocomplete");
if (input != null) {
const attendeeList = document.getElementById("attendees-list");
const filterAttendees = (filter) => {
if (filter == "") {
for (let elt of attendeeList.querySelectorAll("li")) {
elt.classList.remove("hidden");
}
return;
}
let re = "";
for (let c of filter) {
re += `${c}.*`;
}
let filterRe = new RegExp(re, "i");
for (let elt of attendeeList.querySelectorAll("li")) {
const attendee = JSON.parse(elt.dataset.attendee);
if (attendee["bbbg.attendee/meetup-name"].match(filterRe) == null) {
elt.classList.add("hidden");
} else {
elt.classList.remove("hidden");
}
}
};
const attendeeIDInput = document.getElementById("attendee-id");
const submit = document.querySelector("#submit-button");
const signupForm = document.getElementById("signup-form");
input.oninput = (e) => {
filterAttendees(e.target.value);
attendeeIDInput.value = null;
submit.classList.add("hidden");
submit.setAttribute("disabled", "disabled");
signupForm.setAttribute("disabled", "disabled");
};
attendeeList.addEventListener("click", (e) => {
if (!(e.target instanceof HTMLLIElement)) {
return;
}
if (e.target.dataset.attendee == null) {
return;
}
const attendee = JSON.parse(e.target.dataset.attendee);
input.value = attendee["bbbg.attendee/meetup-name"];
attendeeIDInput.value = attendee["bbbg.attendee/id"];
submit.classList.remove("hidden");
submit.removeAttribute("disabled");
signupForm.removeAttribute("disabled");
});
}
document.querySelectorAll("form").forEach((form) => {
form.addEventListener("submit", (e) => {
if (e.target.attributes.disabled) {
e.preventDefault();
}
const confirmMessage = e.target.dataset.confirm;
if (confirmMessage != null && !confirm(confirmMessage)) {
e.stopImmediatePropagation();
e.preventDefault();
}
});
});
};

View file

@ -0,0 +1,2 @@
User-agent: *
Disallow: /

View file

@ -0,0 +1,29 @@
let
depot = import ../../.. { };
in
with depot.third_party.nixpkgs;
mkShell {
buildInputs = [
arion
depot.third_party.clj2nix
clojure
openjdk11_headless
postgresql_12
nix-prefetch-git
(writeShellScriptBin "terraform" ''
set -e
module=$(nix-build ~/code/depot -A users.grfn.bbbg.tf.module)
rm -f ~/tfstate/bbbg/*.json
cp ''${module}/*.json ~/tfstate/bbbg
exec ${depot.users.aspen.bbbg.tf.terraform}/bin/terraform \
-chdir=/home/grfn/tfstate/bbbg \
"$@"
'')
];
PGHOST = "localhost";
PGUSER = "bbbg";
PGDATABASE = "bbbg";
PGPASSWORD = "password";
}

View file

@ -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?)

View file

@ -0,0 +1,4 @@
(ns bbbg.attendee-check
(:require [clojure.spec.alpha :as s]))
(s/def ::id uuid?)

View file

@ -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)))
)

View file

@ -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)
)

View file

@ -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"})
)

View file

@ -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"})
)

View file

@ -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]))))
)

View file

@ -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]}})))

View file

@ -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)))

View file

@ -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")
)

View file

@ -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)))
)

View file

@ -0,0 +1,4 @@
(ns bbbg.event
(:require [clojure.spec.alpha :as s]))
(s/def ::id uuid?)

View file

@ -0,0 +1,6 @@
(ns bbbg.event-attendee
(:require [clojure.spec.alpha :as s]))
(s/def ::attended? boolean?)
(s/def ::rsvpd-attending? boolean?)

View file

@ -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"}))))))

View file

@ -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")))
)

View file

@ -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"])
)

View file

@ -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)
)

View file

@ -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)))))))

View file

@ -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)))))

View file

@ -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-)
)

View file

@ -0,0 +1,6 @@
(ns bbbg.meetup-user
(:require [clojure.spec.alpha :as s]))
(s/def ::id
(s/nilable
(s/and string? seq)))

View file

@ -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))

View file

@ -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?)

View file

@ -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))))))

View file

@ -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")
)

View file

@ -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)
)

View file

@ -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))))))

View file

@ -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)))

View file

@ -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)))
)

View file

@ -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")})})

View file

@ -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]))

View file

@ -0,0 +1,7 @@
(ns bbbg.meetup.import-test
(:require [bbbg.meetup.import :as sut]
[clojure.test :refer :all]))
(deftest test-row-user-id->user-id
(is (= "246364067" (sut/row-user-id->user-id "user 246364067")))
(is (= "246364067" (sut/row-user-id->user-id "246364067"))))

96
users/aspen/bbbg/tf.nix Normal file
View file

@ -0,0 +1,96 @@
{ depot, ... }:
let
inherit (depot.users.aspen)
terraform
;
in
terraform.workspace "bbbg"
{
plugins = (p: with p; [
aws
cloudflare
]);
}
{
machine = terraform.nixosMachine {
name = "bbbg";
instanceType = "t3a.small";
rootVolumeSizeGb = 250;
extraIngressPorts = [ 80 443 ];
configuration = { pkgs, lib, config, depot, ... }: {
imports = [
./module.nix
"${depot.third_party.agenix.src}/modules/age.nix"
];
services.openssh.enable = true;
services.nginx = {
enable = true;
recommendedTlsSettings = true;
recommendedOptimisation = true;
recommendedGzipSettings = true;
recommendedProxySettings = true;
};
networking.firewall.enable = false;
programs.zsh.enable = true;
users.users.grfn = {
isNormalUser = true;
initialPassword = "password";
extraGroups = [
"wheel"
"networkmanager"
"audio"
"docker"
];
shell = pkgs.zsh;
openssh.authorizedKeys.keys = [
depot.users.aspen.keys.main
];
};
security.sudo.extraRules = [{
groups = [ "wheel" ];
commands = [{ command = "ALL"; options = [ "NOPASSWD" ]; }];
}];
nix.gc = {
automatic = true;
dates = "weekly";
options = "--delete-older-than 30d";
};
age.secrets = {
bbbg.file =
depot.users.aspen.secrets."bbbg.age";
};
services.bbbg.enable = true;
services.bbbg.database.enable = true;
services.bbbg.proxy.enable = true;
services.bbbg.domain = "bbbg.gws.fyi";
security.acme.defaults.email = "root@gws.fyi";
security.acme.acceptTerms = true;
};
};
dns = {
data.cloudflare_zone.gws-fyi = {
name = "gws.fyi";
};
resource.cloudflare_record.bbbg = {
zone_id = "\${data.cloudflare_zone.gws-fyi.id}";
name = "bbbg";
type = "A";
value = "\${aws_instance.bbbg_machine.public_ip}";
proxied = false;
};
};
}