├── project.clj ├── CHECKS ├── system.properties ├── bin └── build ├── scripts └── psql ├── src ├── cljc │ └── rocks │ │ └── mygiftlist │ │ ├── type │ │ ├── user.cljc │ │ ├── gift_list.cljc │ │ └── util.cljc │ │ └── transit.cljc ├── cljs │ └── rocks │ │ └── mygiftlist │ │ ├── config.cljs │ │ ├── model │ │ ├── gift_list.cljs │ │ └── user.cljs │ │ ├── development_preload.cljs │ │ ├── application.cljs │ │ ├── authentication.cljs │ │ ├── routing.cljs │ │ ├── client.cljs │ │ ├── ui │ │ ├── navigation.cljs │ │ ├── root.cljs │ │ └── gift_list.cljs │ │ └── http_remote.cljs └── clj │ └── rocks │ └── mygiftlist │ ├── main.clj │ ├── config.clj │ ├── model │ ├── user.clj │ └── gift_list.clj │ ├── server.clj │ ├── authentication.clj │ ├── db.clj │ └── parser.clj ├── dev ├── resources │ ├── dev.edn │ └── test.edn └── user.clj ├── sass └── style.scss ├── Procfile ├── .dockerignore ├── .gitignore ├── migrations ├── V2__CreateGiftListTable.sql └── V1__CreateUserTable.sql ├── .dir-locals.el ├── docker-compose.yaml ├── .joker ├── .clj-kondo └── config.edn ├── resources ├── public │ └── index.html ├── config.edn └── system.edn ├── package.json ├── migrate └── rocks │ └── mygiftlist │ └── migrate.clj ├── Makefile ├── shadow-cljs.edn ├── test └── rocks │ └── mygiftlist │ ├── test_helper.clj │ └── model │ ├── user_test.clj │ └── gift_list_test.clj ├── README.md └── deps.edn /project.clj: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /CHECKS: -------------------------------------------------------------------------------- 1 | / My Gift List Rocks -------------------------------------------------------------------------------- /system.properties: -------------------------------------------------------------------------------- 1 | java.runtime.version=14 -------------------------------------------------------------------------------- /bin/build: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | make uberjar -------------------------------------------------------------------------------- /scripts/psql: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | docker-compose exec -u postgres postgres psql -------------------------------------------------------------------------------- /src/cljc/rocks/mygiftlist/type/user.cljc: -------------------------------------------------------------------------------- 1 | (ns rocks.mygiftlist.type.user) 2 | -------------------------------------------------------------------------------- /dev/resources/dev.edn: -------------------------------------------------------------------------------- 1 | {:rocks.mygiftlist.config/config {:rocks.mygiftlist.config/profile :dev}} 2 | -------------------------------------------------------------------------------- /dev/resources/test.edn: -------------------------------------------------------------------------------- 1 | {:rocks.mygiftlist.config/config {:rocks.mygiftlist.config/profile :test}} 2 | -------------------------------------------------------------------------------- /sass/style.scss: -------------------------------------------------------------------------------- 1 | .mgl_flex-container { 2 | display: flex; 3 | align-items: flex-start; 4 | } 5 | -------------------------------------------------------------------------------- /Procfile: -------------------------------------------------------------------------------- 1 | web: java -cp target/mygiftlistrocks.jar clojure.main -m rocks.mygiftlist.main 2 | release: clojure -X:migrate 3 | -------------------------------------------------------------------------------- /.dockerignore: -------------------------------------------------------------------------------- 1 | resources/public/js 2 | resources/public/css 3 | node_modules 4 | .cpcache 5 | .shadow-cljs 6 | .nrepl-port 7 | .clj-kondo/.cache 8 | target -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | resources/public/js 2 | resources/public/css 3 | node_modules 4 | .cpcache 5 | .shadow-cljs 6 | .nrepl-port 7 | .clj-kondo/.cache 8 | target -------------------------------------------------------------------------------- /src/cljs/rocks/mygiftlist/config.cljs: -------------------------------------------------------------------------------- 1 | (ns rocks.mygiftlist.config) 2 | 3 | (goog-define AUTH0_DOMAIN "") 4 | (goog-define AUTH0_CLIENT_ID "") 5 | (goog-define AUTH0_AUDIENCE "") 6 | (goog-define AUTH0_CONNECTION "") 7 | -------------------------------------------------------------------------------- /src/cljc/rocks/mygiftlist/type/gift_list.cljc: -------------------------------------------------------------------------------- 1 | (ns rocks.mygiftlist.type.gift-list 2 | (:require [clojure.spec.alpha :as s] 3 | [rocks.mygiftlist.type.util :as t.util])) 4 | 5 | (s/def ::name ::t.util/nonblank-string) 6 | -------------------------------------------------------------------------------- /src/cljc/rocks/mygiftlist/type/util.cljc: -------------------------------------------------------------------------------- 1 | (ns rocks.mygiftlist.type.util 2 | (:require [clojure.string :as str] 3 | [clojure.spec.alpha :as s])) 4 | 5 | (s/def ::nonblank-string (s/and string? (complement str/blank?))) 6 | -------------------------------------------------------------------------------- /migrations/V2__CreateGiftListTable.sql: -------------------------------------------------------------------------------- 1 | CREATE TABLE gift_list ( 2 | id uuid PRIMARY KEY DEFAULT gen_random_uuid(), 3 | created_by_id uuid NOT NULL REFERENCES "user" (id), 4 | created_at timestamp with time zone DEFAULT now() NOT NULL, 5 | name text NOT NULL 6 | ); 7 | -------------------------------------------------------------------------------- /migrations/V1__CreateUserTable.sql: -------------------------------------------------------------------------------- 1 | CREATE EXTENSION IF NOT EXISTS pgcrypto WITH SCHEMA public; 2 | 3 | CREATE TABLE "user" ( 4 | id uuid PRIMARY KEY DEFAULT gen_random_uuid(), 5 | email text NOT NULL UNIQUE, 6 | auth0_id text NOT NULL UNIQUE, 7 | created_at timestamp with time zone DEFAULT now() NOT NULL 8 | ); 9 | -------------------------------------------------------------------------------- /.dir-locals.el: -------------------------------------------------------------------------------- 1 | ((nil . ((fill-column . 70) 2 | (column-enforce-column . 70) 3 | (cider-default-cljs-repl . shadow) 4 | (cider-shadow-default-options . ":dev") 5 | (cider-shadow-cljs-global-options . "-A:dev:backend:frontend:test") 6 | (cider-preferred-build-tool . shadow-cljs)))) 7 | -------------------------------------------------------------------------------- /docker-compose.yaml: -------------------------------------------------------------------------------- 1 | version: "3.7" 2 | services: 3 | postgres: 4 | image: postgres:13.1 5 | restart: always 6 | environment: 7 | POSTGRES_PASSWORD: password 8 | ports: 9 | - "${POSTGRES_PORT:-15432}:5432" 10 | volumes: 11 | - db_data:/var/lib/postgresql/data 12 | volumes: 13 | db_data: 14 | -------------------------------------------------------------------------------- /.joker: -------------------------------------------------------------------------------- 1 | {:rules {:if-without-else true 2 | :unused-fn-parameters true} 3 | :known-macros [com.fulcrologic.fulcro.mutations/defmutation 4 | com.fulcrologic.fulcro.algorithms.normalized-state/swap!-> 5 | com.wsscode.pathom.connect/defresolver 6 | com.wsscode.pathom.connect/defmutation 7 | com.fulcrologic.fulcro.components/defsc 8 | com.fulcrologic.fulcro.routing.dynamic-routing/defrouter]} 9 | -------------------------------------------------------------------------------- /src/clj/rocks/mygiftlist/main.clj: -------------------------------------------------------------------------------- 1 | (ns rocks.mygiftlist.main 2 | (:require rocks.mygiftlist.server 3 | rocks.mygiftlist.parser 4 | rocks.mygiftlist.db 5 | rocks.mygiftlist.config 6 | rocks.mygiftlist.authentication 7 | [integrant.core :as ig] 8 | [clojure.java.io :as io])) 9 | 10 | (defn -main [& _args] 11 | (-> "system.edn" 12 | io/resource 13 | slurp 14 | ig/read-string 15 | ig/init)) 16 | -------------------------------------------------------------------------------- /src/cljc/rocks/mygiftlist/transit.cljc: -------------------------------------------------------------------------------- 1 | (ns rocks.mygiftlist.transit 2 | #?(:clj (:require [cognitect.transit :as t])) 3 | #?(:clj (:import [java.time Instant]))) 4 | 5 | (def write-handlers 6 | #?(:clj 7 | {Instant (t/write-handler "m" 8 | (fn [^Instant t] (.toEpochMilli t)) 9 | (fn [^Instant t] (.toString (.toEpochMilli t))))} 10 | :cljs {})) 11 | 12 | (def read-handlers 13 | #?(:clj 14 | {"m" (t/read-handler 15 | (fn [s] (Instant/ofEpochMilli s)))} 16 | :cljs {})) 17 | -------------------------------------------------------------------------------- /.clj-kondo/config.edn: -------------------------------------------------------------------------------- 1 | {:lint-as {com.fulcrologic.fulcro.mutations/defmutation clojure.core/defrecord 2 | com.wsscode.pathom.connect/defresolver clojure.core/defn 3 | com.wsscode.pathom.connect/defmutation clojure.core/defn 4 | com.fulcrologic.fulcro.components/defsc clojure.core/defn 5 | com.fulcrologic.fulcro.routing.dynamic-routing/defrouter clojure.core/defn 6 | com.fulcrologic.fulcro.algorithms.normalized-state/swap!-> clojure.core/-> 7 | com.wsscode.async.async-cljs/let-chan clojure.core/let}} 8 | -------------------------------------------------------------------------------- /resources/public/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | My Gift List Rocks 4 | 5 | 6 | 7 | 8 | 9 | 10 |
11 | 12 | 13 | 14 | -------------------------------------------------------------------------------- /src/cljs/rocks/mygiftlist/model/gift_list.cljs: -------------------------------------------------------------------------------- 1 | (ns rocks.mygiftlist.model.gift-list 2 | (:require 3 | [rocks.mygiftlist.type.gift-list :as gift-list] 4 | [com.fulcrologic.fulcro.algorithms.normalized-state :refer [swap!->]] 5 | [com.fulcrologic.fulcro.mutations :as m :refer [defmutation]])) 6 | 7 | (defmutation create-gift-list [{::gift-list/keys [id] :as gift-list}] 8 | (action [{:keys [state]}] 9 | (swap!-> state 10 | (assoc-in [::gift-list/id id] gift-list) 11 | (update-in [:component/id :left-nav :created-gift-lists] 12 | conj gift-list))) 13 | (remote [_] true)) 14 | -------------------------------------------------------------------------------- /dev/user.clj: -------------------------------------------------------------------------------- 1 | (ns user 2 | (:require 3 | rocks.mygiftlist.server 4 | rocks.mygiftlist.parser 5 | rocks.mygiftlist.db 6 | rocks.mygiftlist.config 7 | rocks.mygiftlist.authentication 8 | [integrant.core :as ig] 9 | [integrant.repl :refer [clear go halt prep init reset reset-all]] 10 | [integrant.repl.state :refer [system]] 11 | [clojure.java.io :as io])) 12 | 13 | (integrant.repl/set-prep! 14 | (fn [] 15 | (merge 16 | (ig/read-string (slurp (io/resource "system.edn"))) 17 | (ig/read-string (slurp (io/resource "resources/dev.edn")))))) 18 | 19 | (comment 20 | system 21 | (go) 22 | (reset) 23 | (halt) 24 | ) 25 | -------------------------------------------------------------------------------- /src/cljs/rocks/mygiftlist/development_preload.cljs: -------------------------------------------------------------------------------- 1 | (ns rocks.mygiftlist.development-preload 2 | (:require [com.fulcrologic.fulcro.algorithms.timbre-support :as ts] 3 | [taoensso.timbre :as log])) 4 | 5 | ;; Add code to this file that should run when the initial application is loaded in development mode. 6 | ;; shadow-cljs already enables console print and plugs in devtools if they are on the classpath, 7 | 8 | (js/console.log "Turning logging to :all (in rocks.mygiftlist.development-preload)") 9 | (log/set-level! :debug) 10 | (log/merge-config! {:output-fn ts/prefix-output-fn 11 | :appenders {:console (ts/console-appender)}}) 12 | -------------------------------------------------------------------------------- /src/clj/rocks/mygiftlist/config.clj: -------------------------------------------------------------------------------- 1 | (ns rocks.mygiftlist.config 2 | (:require [integrant.core :as ig] 3 | [clojure.java.io :as io] 4 | [aero.core :as aero])) 5 | 6 | (defmethod ig/init-key ::config 7 | [_ {::keys [profile]}] 8 | (aero/read-config (io/resource "config.edn") 9 | {:profile profile})) 10 | 11 | (defn database-opts [config] 12 | (:database-opts config)) 13 | 14 | (defn port [config] 15 | (:port config)) 16 | 17 | (defn jwk-endpoint [config] 18 | (get-in config [:auth :jwk-endpoint])) 19 | 20 | (defn jwt-issuer [config] 21 | (get-in config [:auth :issuer])) 22 | 23 | (defn jwt-audience [config] 24 | (get-in config [:auth :audience])) 25 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "mygiftlist", 3 | "version": "1.0.0", 4 | "description": "", 5 | "private": true, 6 | "devDependencies": { 7 | "@auth0/auth0-spa-js": "^1.13.5", 8 | "node-sass": "^5.0.0", 9 | "react": "^17.0.1", 10 | "react-dom": "^17.0.1", 11 | "semantic-ui-react": "^2.0.1", 12 | "shadow-cljs": "^2.11.10" 13 | }, 14 | "scripts": { 15 | "css-build": "node-sass --omit-source-map-url sass/style.scss resources/public/css/style.css", 16 | "css-watch": "node-sass --omit-source-map-url sass/style.scss resources/public/css/style.css --watch" 17 | }, 18 | "author": "Chris O'Donnell", 19 | "license": "MIT", 20 | "dependencies": {} 21 | } 22 | -------------------------------------------------------------------------------- /resources/config.edn: -------------------------------------------------------------------------------- 1 | {:database-opts {:database-url #profile {:dev "postgresql://postgres:password@localhost:15432/postgres" 2 | :test "postgresql://postgres:password@localhost:15433/postgres" 3 | :prod #env DATABASE_URL} 4 | :sslmode #or [#env POSTGRES_SSLMODE "disable"]} 5 | :port #long #profile {:dev 3000 6 | :test 3001 7 | :prod #env PORT} 8 | :auth {:jwk-endpoint #or [#env JWK_ENDPOINT "https://mygiftlist-blog.auth0.com/.well-known/jwks.json"] 9 | :issuer #or [#env JWT_ISSUER "https://mygiftlist-blog.auth0.com/"] 10 | :audience #or [#env JWT_AUDIENCE "https://blog.mygiftlist.rocks"]}} 11 | -------------------------------------------------------------------------------- /resources/system.edn: -------------------------------------------------------------------------------- 1 | {:rocks.mygiftlist.config/config 2 | {:rocks.mygiftlist.config/profile :prod} 3 | 4 | :rocks.mygiftlist.authentication/wrap-jwt 5 | {:rocks.mygiftlist.config/config #ig/ref :rocks.mygiftlist.config/config} 6 | 7 | :rocks.mygiftlist.db/pool 8 | {:rocks.mygiftlist.config/config #ig/ref :rocks.mygiftlist.config/config} 9 | 10 | :rocks.mygiftlist.parser/parser 11 | {:rocks.mygiftlist.db/pool #ig/ref :rocks.mygiftlist.db/pool} 12 | 13 | :rocks.mygiftlist.server/server 14 | {:rocks.mygiftlist.parser/parser #ig/ref :rocks.mygiftlist.parser/parser 15 | :rocks.mygiftlist.db/pool #ig/ref :rocks.mygiftlist.db/pool 16 | :rocks.mygiftlist.authentication/wrap-jwt #ig/ref :rocks.mygiftlist.authentication/wrap-jwt 17 | :rocks.mygiftlist.config/config #ig/ref :rocks.mygiftlist.config/config}} 18 | -------------------------------------------------------------------------------- /src/cljs/rocks/mygiftlist/model/user.cljs: -------------------------------------------------------------------------------- 1 | (ns rocks.mygiftlist.model.user 2 | (:require 3 | [rocks.mygiftlist.type.user :as user] 4 | [edn-query-language.core :as eql] 5 | [com.fulcrologic.fulcro.algorithms.normalized-state :refer [swap!->]] 6 | [com.fulcrologic.fulcro.mutations :as m :refer [defmutation]])) 7 | 8 | (defmutation set-current-user [{::user/keys [id auth0-id email] 9 | :as user}] 10 | (action [{:keys [state]}] 11 | (swap!-> state 12 | (assoc-in [:component/id :current-user] [::user/id id]) 13 | (assoc-in [::user/id id] user))) 14 | (remote [_] 15 | (eql/query->ast1 `[(create-user 16 | #::user{:id ~id 17 | :auth0-id ~auth0-id 18 | :email ~email})]))) 19 | -------------------------------------------------------------------------------- /src/cljs/rocks/mygiftlist/application.cljs: -------------------------------------------------------------------------------- 1 | (ns rocks.mygiftlist.application 2 | (:require [com.fulcrologic.fulcro.application :as app] 3 | [com.fulcrologic.fulcro.rendering.keyframe-render2 :as keyframe-render2] 4 | [com.fulcrologic.fulcro.networking.http-remote :as f.http-remote] 5 | [rocks.mygiftlist.http-remote :as http-remote] 6 | [rocks.mygiftlist.transit :as transit])) 7 | 8 | (defonce SPA 9 | (app/fulcro-app 10 | {:optimized-render! keyframe-render2/render! 11 | :remotes {:remote (http-remote/fulcro-http-remote 12 | {:request-middleware 13 | (http-remote/wrap-fulcro-request 14 | identity transit/write-handlers) 15 | :response-middleware 16 | (f.http-remote/wrap-fulcro-response 17 | identity transit/read-handlers)})}})) 18 | -------------------------------------------------------------------------------- /migrate/rocks/mygiftlist/migrate.clj: -------------------------------------------------------------------------------- 1 | (ns rocks.mygiftlist.migrate 2 | (:require [clojure.string :as str]) 3 | (:import [java.net URI] 4 | [org.flywaydb.core Flyway] 5 | [org.flywaydb.core.api Location])) 6 | 7 | (defn database-url->datasource-args [database-url] 8 | (let [{:keys [userInfo host port path]} (bean (URI. database-url)) 9 | [username password] (str/split userInfo #":")] 10 | {:jdbc-url (str "jdbc:postgresql://" host ":" port path) 11 | :username username 12 | :password password})) 13 | 14 | (defn migrate [{:keys [database-url]}] 15 | (let [{:keys [jdbc-url username password]} 16 | (database-url->datasource-args 17 | (or database-url (System/getenv "DATABASE_URL")))] 18 | (.. (Flyway/configure) 19 | (dataSource jdbc-url username password) 20 | (locations (into-array Location 21 | [(Location. "filesystem:./migrations")])) 22 | (load) 23 | (migrate)))) 24 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: test test-up test-down migrate uberjar run build-report outdated 2 | 3 | test: 4 | POSTGRES_PORT=15433 docker-compose -p mygiftlist-blog-test up -d 5 | clojure -X:migrate :database-url '"postgresql://postgres:password@localhost:15433/postgres"' 6 | clojure -M:backend:dev:test:run-tests 7 | docker-compose -p mygiftlist-blog-test down 8 | 9 | test-up: 10 | POSTGRES_PORT=15433 docker-compose -p mygiftlist-blog-test up -d 11 | clojure -X:migrate :database-url '"postgresql://postgres:password@localhost:15433/postgres"' 12 | 13 | test-down: 14 | docker-compose -p mygiftlist-blog-test down 15 | 16 | migrate: 17 | clojure -X:migrate :database-url '"postgresql://postgres:password@localhost:15432/postgres"' 18 | 19 | uberjar: 20 | npm install 21 | npx shadow-cljs release prod 22 | npm run css-build 23 | clojure -X:depstar uberjar :jar target/mygiftlistrocks.jar :aliases '[:backend]' 24 | 25 | run: 26 | java -cp target/mygiftlistrocks.jar clojure.main -m rocks.mygiftlist.main 27 | 28 | build-report: 29 | npx shadow-cljs run shadow.cljs.build-report prod report.html 30 | 31 | outdated: 32 | clojure -M:outdated -a backend,frontend,dev,test,depstar,migrate,outdated 33 | -------------------------------------------------------------------------------- /src/cljs/rocks/mygiftlist/authentication.cljs: -------------------------------------------------------------------------------- 1 | (ns rocks.mygiftlist.authentication 2 | (:require ["@auth0/auth0-spa-js" :as create-auth0-client] 3 | [com.wsscode.async.async-cljs :refer [go-promise clj ( (db/execute-one! pool 27 | {:insert-into :user 28 | :values [{:auth0_id auth0-id 29 | :email email}] 30 | :upsert {:on-conflict [:auth0_id] 31 | :do-update-set [:email]} 32 | :returning [:id]}) 33 | id (assign-tempid id)))) 34 | 35 | (def user-resolvers 36 | [user-by-id 37 | create-user]) 38 | -------------------------------------------------------------------------------- /shadow-cljs.edn: -------------------------------------------------------------------------------- 1 | {:deps {:aliases [:frontend]} 2 | :nrepl {:middleware [cider.nrepl/cider-middleware 3 | refactor-nrepl.middleware/wrap-refactor]} 4 | :builds {:dev {:target :browser 5 | :output-dir "resources/public/js" 6 | :asset-path "/js" 7 | 8 | :modules {:main {:entries [rocks.mygiftlist.client] 9 | :init-fn rocks.mygiftlist.client/init}} 10 | 11 | :closure-defines 12 | {rocks.mygiftlist.config/AUTH0_CLIENT_ID "heIlMgUZmvjI3muqPO3Ua5F5VpLgTpM3" 13 | rocks.mygiftlist.config/AUTH0_DOMAIN "mygiftlist-blog.auth0.com" 14 | rocks.mygiftlist.config/AUTH0_AUDIENCE "https://blog.mygiftlist.rocks" 15 | rocks.mygiftlist.config/AUTH0_CONNECTION "Username-Password-Authentication"} 16 | 17 | :devtools {:watch-dir "resources/public" 18 | :after-load rocks.mygiftlist.client/refresh 19 | :preloads [com.fulcrologic.fulcro.inspect.preload 20 | rocks.mygiftlist.development-preload]}} 21 | :prod {:target :browser 22 | :output-dir "resources/public/js" 23 | :asset-path "/js" 24 | 25 | :modules {:main {:entries [rocks.mygiftlist.client] 26 | :init-fn rocks.mygiftlist.client/init}} 27 | 28 | :closure-defines 29 | {rocks.mygiftlist.config/AUTH0_CLIENT_ID "heIlMgUZmvjI3muqPO3Ua5F5VpLgTpM3" 30 | rocks.mygiftlist.config/AUTH0_DOMAIN "mygiftlist-blog.auth0.com" 31 | rocks.mygiftlist.config/AUTH0_AUDIENCE "https://blog.mygiftlist.rocks" 32 | rocks.mygiftlist.config/AUTH0_CONNECTION "Username-Password-Authentication"}}}} 33 | -------------------------------------------------------------------------------- /src/cljs/rocks/mygiftlist/routing.cljs: -------------------------------------------------------------------------------- 1 | (ns rocks.mygiftlist.routing 2 | (:require [rocks.mygiftlist.application :refer [SPA]] 3 | [clojure.string :as str] 4 | [com.fulcrologic.fulcro.application :as app] 5 | [com.fulcrologic.fulcro.components :as comp] 6 | [com.fulcrologic.fulcro.mutations :refer [defmutation]] 7 | [com.fulcrologic.fulcro.routing.dynamic-routing :as dr] 8 | [edn-query-language.core :as eql] 9 | [pushy.core :as pushy])) 10 | 11 | (defn url->path 12 | "Given a url of the form \"/gift/123/edit?code=abcdef\", returns a 13 | path vector of the form [\"gift\" \"123\" \"edit\"]. Assumes the url 14 | starts with a forward slash. An empty url yields the path [\"home\"] 15 | instead of []." 16 | [url] 17 | (-> url (str/split "?") first (str/split "/") rest vec)) 18 | 19 | (defn path->url 20 | "Given a path vector of the form [\"gift\" \"123\" \"edit\"], 21 | returns a url of the form \"/gift/123/edit\"." 22 | [path] 23 | (str/join (interleave (repeat "/") path))) 24 | 25 | (defn routable-path? 26 | "True if there exists a router target for the given path." 27 | [app path] 28 | (let [state-map (app/current-state app) 29 | root-class (app/root-class app) 30 | root-query (comp/get-query root-class state-map) 31 | ast (eql/query->ast root-query)] 32 | (some? (dr/ast-node-for-route ast path)))) 33 | 34 | (def default-route ["home"]) 35 | 36 | (defonce history (pushy/pushy 37 | (fn [path] 38 | (dr/change-route SPA path)) 39 | (fn [url] 40 | (let [path (url->path url)] 41 | (if (routable-path? SPA path) 42 | path 43 | default-route))))) 44 | 45 | (defn start! [] 46 | (dr/initialize! SPA) 47 | (pushy/start! history)) 48 | 49 | (defn route-to! [path] 50 | (pushy/set-token! history (path->url path))) 51 | 52 | (defmutation route-to 53 | [{:keys [path]}] 54 | (action [_] 55 | (route-to! path))) 56 | -------------------------------------------------------------------------------- /test/rocks/mygiftlist/test_helper.clj: -------------------------------------------------------------------------------- 1 | (ns rocks.mygiftlist.test-helper 2 | (:require [rocks.mygiftlist.authentication :as auth] 3 | [rocks.mygiftlist.db :as db] 4 | [next.jdbc :as jdbc] 5 | [integrant.core :as ig] 6 | [clojure.java.io :as io] 7 | [clojure.string :as str] 8 | [rocks.mygiftlist.type.user :as user])) 9 | 10 | (def system nil) 11 | 12 | (defn use-system 13 | "Test fixture that initializes system components and sets it as the 14 | value of the `system` var, runs the test, then halts system 15 | components and resets `system` to nil. If no system components are 16 | passed in, initializes and halts the full system." 17 | [& component-keys] 18 | (fn [test-fn] 19 | (alter-var-root #'system 20 | (fn [_] 21 | (let [ig-config (merge 22 | (ig/read-string 23 | (slurp (io/resource "system.edn"))) 24 | (ig/read-string 25 | (slurp (io/resource "resources/test.edn"))))] 26 | (if (seq component-keys) 27 | (ig/init ig-config component-keys) 28 | (ig/init ig-config))))) 29 | (test-fn) 30 | (ig/halt! system) 31 | (alter-var-root #'system (constantly nil)))) 32 | 33 | (def ^:private tables 34 | [:user]) 35 | 36 | (defn- double-quote [s] 37 | (format "\"%s\"" s)) 38 | 39 | (def ^:private truncate-all-tables 40 | "SQL vector that truncates all tables" 41 | [(str "TRUNCATE " 42 | (str/join " " (mapv (comp double-quote name) tables)) 43 | " CASCADE")]) 44 | 45 | (defn truncate-after 46 | "Test fixtures that truncates all database tables after running the 47 | test. Assumes the `use-system` fixture has started the database 48 | connection pool." 49 | [test-fn] 50 | (test-fn) 51 | (jdbc/execute-one! (::db/pool system) truncate-all-tables)) 52 | 53 | (defn authenticate-with 54 | "Adds authentication claims to `env` for the given user." 55 | [env {::user/keys [auth0-id]}] 56 | (assoc-in env [:ring/request ::auth/claims :sub] auth0-id)) 57 | -------------------------------------------------------------------------------- /src/clj/rocks/mygiftlist/model/gift_list.clj: -------------------------------------------------------------------------------- 1 | (ns rocks.mygiftlist.model.gift-list 2 | (:require 3 | [com.wsscode.pathom.connect :as pc :refer [defresolver defmutation]] 4 | [rocks.mygiftlist.db :as db] 5 | [rocks.mygiftlist.type.gift-list :as gift-list] 6 | [rocks.mygiftlist.type.user :as user])) 7 | 8 | (defresolver gift-list-by-id 9 | [{::db/keys [pool] :keys [requester-id]} inputs] 10 | {::pc/input #{::gift-list/id} 11 | ::pc/output [::gift-list/id ::gift-list/name ::gift-list/created-at 12 | {::gift-list/created-by [::user/id]}] 13 | ::pc/transform pc/transform-batch-resolver} 14 | (->> {:select [:gl.id :gl.name :gl.created_at :gl.created_by_id] 15 | :from [[:gift_list :gl]] 16 | :where [:and 17 | [:= requester-id :gl.created_by_id] 18 | [:in :gl.id (mapv ::gift-list/id inputs)]]} 19 | (db/execute! pool) 20 | (mapv (fn [{::gift-list/keys [created-by-id] :as gift-list}] 21 | (-> gift-list 22 | (assoc-in [::gift-list/created-by ::user/id] created-by-id) 23 | (dissoc ::gift-list/created-by-id)))) 24 | (pc/batch-restore-sort {::pc/inputs inputs ::pc/key ::gift-list/id}))) 25 | 26 | (defresolver created-gift-lists 27 | [{::db/keys [pool] :keys [requester-id]} _] 28 | {::pc/input #{} 29 | ::pc/output [{:created-gift-lists [::gift-list/id]}]} 30 | {:created-gift-lists 31 | (db/execute! pool 32 | {:select [:gl.id] 33 | :from [[:gift_list :gl]] 34 | :where [:= requester-id :gl.created_by_id] 35 | :order-by [:gl.created_at]})}) 36 | 37 | (defmutation create-gift-list 38 | [{::db/keys [pool] :keys [requester-id]} {::gift-list/keys [id name]}] 39 | {::pc/params #{::gift-list/id ::gift-list/name} 40 | ::pc/output [::gift-list/id]} 41 | (when requester-id 42 | (db/execute-one! pool 43 | {:insert-into :gift_list 44 | :values [{:id id 45 | :name name 46 | :created_by_id requester-id}] 47 | :upsert {:on-conflict [:id] 48 | :do-update-set [:id]} 49 | :returning [:id]}))) 50 | 51 | (def gift-list-resolvers 52 | [gift-list-by-id 53 | created-gift-lists 54 | create-gift-list]) 55 | -------------------------------------------------------------------------------- /src/clj/rocks/mygiftlist/server.clj: -------------------------------------------------------------------------------- 1 | (ns rocks.mygiftlist.server 2 | (:require [integrant.core :as ig] 3 | [org.httpkit.server :as http-kit] 4 | [rocks.mygiftlist.authentication :as auth] 5 | [rocks.mygiftlist.config :as config] 6 | [rocks.mygiftlist.db :as db] 7 | [rocks.mygiftlist.parser :as parser] 8 | [rocks.mygiftlist.transit :as transit] 9 | [com.fulcrologic.fulcro.server.api-middleware 10 | :refer [wrap-transit-params 11 | wrap-transit-response]] 12 | [ring.util.response :as resp] 13 | [ring.middleware.defaults :refer [wrap-defaults 14 | site-defaults]] 15 | [ring.middleware.gzip :as gzip])) 16 | 17 | (defn- not-found-handler [_] 18 | (assoc-in (resp/resource-response "public/index.html") 19 | [:headers "Content-Type"] "text/html")) 20 | 21 | (defn- wrap-api [handler parser uri] 22 | (fn [request] 23 | (if (= uri (:uri request)) 24 | {:status 200 25 | :body (parser {:ring/request request} 26 | (:transit-params request)) 27 | :headers {"Content-Type" "application/transit+json"}} 28 | (handler request)))) 29 | 30 | (defn- wrap-healthcheck [handler pool uri] 31 | (fn [request] 32 | (if (= uri (:uri request)) 33 | (do (db/execute! pool {:select [1] :from [:user]}) 34 | {:status 200 35 | :body "Success" 36 | :headers {"Content-Type" "text/plain"}}) 37 | (handler request)))) 38 | 39 | (defn handler [{:keys [parser wrap-jwt pool]}] 40 | (-> not-found-handler 41 | (wrap-api parser "/api") 42 | (wrap-healthcheck pool "/heathcheck") 43 | wrap-jwt 44 | (wrap-transit-params {:opts {:handlers transit/read-handlers}}) 45 | (wrap-transit-response {:opts {:handlers transit/write-handlers}}) 46 | (wrap-defaults (assoc-in site-defaults 47 | [:security :anti-forgery] false)) 48 | gzip/wrap-gzip)) 49 | 50 | (defmethod ig/init-key ::server 51 | [_ {::parser/keys [parser] 52 | ::config/keys [config] 53 | ::db/keys [pool] 54 | ::auth/keys [wrap-jwt]}] 55 | (http-kit/run-server (handler {:parser parser 56 | :config config 57 | :pool pool 58 | :wrap-jwt wrap-jwt}) 59 | {:port (:port config)})) 60 | 61 | (defmethod ig/halt-key! ::server 62 | [_ server] 63 | (server)) 64 | -------------------------------------------------------------------------------- /src/cljs/rocks/mygiftlist/client.cljs: -------------------------------------------------------------------------------- 1 | (ns rocks.mygiftlist.client 2 | (:require 3 | [rocks.mygiftlist.application :refer [SPA]] 4 | [rocks.mygiftlist.authentication :as auth] 5 | [rocks.mygiftlist.routing :as routing] 6 | [rocks.mygiftlist.model.user :as m.user] 7 | [rocks.mygiftlist.type.user :as user] 8 | [rocks.mygiftlist.ui.navigation :as ui.nav] 9 | [rocks.mygiftlist.ui.root :as ui.root] 10 | [com.fulcrologic.fulcro.algorithms.normalized-state :refer [swap!->]] 11 | [com.fulcrologic.fulcro.algorithms.tempid :as tempid] 12 | [com.fulcrologic.fulcro.application :as app] 13 | [com.fulcrologic.fulcro.components :as comp] 14 | [com.fulcrologic.fulcro.data-fetch :as df] 15 | [com.fulcrologic.fulcro.routing.dynamic-routing :as dr] 16 | [com.fulcrologic.fulcro.mutations :refer [defmutation]] 17 | [clojure.core.async :as async :refer [go state 24 | (assoc-in [:component/id :login-logout :ui/authenticated] authenticated) 25 | (assoc :root/loading false)))) 26 | 27 | (defn ^:export refresh [] 28 | (log/info "Hot code reload...") 29 | (app/mount! SPA ui.root/Root "app")) 30 | 31 | (defn- is-redirect? [] 32 | (str/includes? (.. js/window -location -search) "code=")) 33 | 34 | (defn- clear-query-params! [] 35 | (.replaceState js/window.history #js {} js/document.title js/window.location.pathname)) 36 | 37 | (defn ^:export init [] 38 | (log/info "Application starting...") 39 | (app/mount! SPA ui.root/Root "app") 40 | (go 41 | ( url 13 | (URL.) 14 | (UrlJwkProvider.) 15 | (GuavaCachedJwkProvider.))] 16 | (reify RSAKeyProvider 17 | (getPublicKeyById [_ key-id] 18 | (-> provider 19 | (.get key-id) 20 | (.getPublicKey))) 21 | (getPrivateKey [_] nil) 22 | (getPrivateKeyId [_] nil)))) 23 | 24 | (defn verify-token 25 | "Given a key-provider created by `create-key-provider`, an issuer, 26 | an audience, and a jwt, decodes the jwt and returns it if the jwt is 27 | valid. Returns nil if the jwt is invalid." 28 | [key-provider {:keys [issuer audience]} token] 29 | (let [algorithm (Algorithm/RSA256 key-provider) 30 | verifier (-> algorithm 31 | (JWT/require) 32 | (.withIssuer (into-array String [issuer])) 33 | (.withAudience (into-array String [audience])) 34 | (.build))] 35 | (try 36 | (let [decoded-jwt (.verify verifier token)] 37 | {:iss (.getIssuer decoded-jwt) 38 | :sub (.getSubject decoded-jwt) 39 | :aud (vec (.getAudience decoded-jwt)) 40 | :iat (.toInstant (.getIssuedAt decoded-jwt)) 41 | :exp (.toInstant (.getExpiresAt decoded-jwt)) 42 | :azp (.asString (.getClaim decoded-jwt "azp")) 43 | :scope (.asString (.getClaim decoded-jwt "scope"))}) 44 | (catch JWTVerificationException _ 45 | nil)))) 46 | 47 | (defn- get-token [req] 48 | (when-let [header (get-in req [:headers "authorization"])] 49 | (second (re-find #"^Bearer (.+)" header)))) 50 | 51 | (defn wrap-jwt 52 | "Middleware that verifies and adds claim data to a request based on 53 | a bearer token in the header. 54 | 55 | If a bearer token is found in the authorization header, attempts to 56 | verify it. If verification succeeds, adds the token's claims to the 57 | request under the `::claims` key. If verification fails, leaves the 58 | request unchanged." 59 | [handler key-provider expected-claims] 60 | (fn [req] 61 | (let [token (get-token req) 62 | claims (when token 63 | (verify-token key-provider expected-claims token))] 64 | (handler (cond-> req 65 | claims (assoc ::claims claims)))))) 66 | 67 | (defmethod ig/init-key ::wrap-jwt 68 | [_ {::config/keys [config]}] 69 | (fn [handler] 70 | (wrap-jwt handler 71 | (create-key-provider 72 | (config/jwk-endpoint config)) 73 | {:issuer (config/jwt-issuer config) 74 | :audience (config/jwt-audience config)}))) 75 | -------------------------------------------------------------------------------- /src/cljs/rocks/mygiftlist/ui/root.cljs: -------------------------------------------------------------------------------- 1 | (ns rocks.mygiftlist.ui.root 2 | (:require 3 | [rocks.mygiftlist.authentication :as auth] 4 | [rocks.mygiftlist.ui.navigation :as ui.nav] 5 | [rocks.mygiftlist.ui.gift-list :as ui.gift-list] 6 | [com.fulcrologic.fulcro.components :as comp :refer [defsc]] 7 | [com.fulcrologic.fulcro.dom :as dom] 8 | [com.fulcrologic.fulcro.routing.dynamic-routing :as dr :refer [defrouter]] 9 | [rocks.mygiftlist.type.user :as user])) 10 | 11 | (defsc LoginForm [_this _] 12 | {:query [] 13 | :ident (fn [] [:component/id :login]) 14 | :route-segment ["login"] 15 | :initial-state {}} 16 | (dom/div {} 17 | (dom/div "In order to view and create gift lists, you need to...") 18 | (dom/div (dom/button :.ui.primary.button 19 | {:onClick #(auth/login)} 20 | "Log in or sign up")))) 21 | 22 | (defsc Home [_this {:ui/keys [gift-list-form-panel]}] 23 | {:query [{:ui/gift-list-form-panel (comp/get-query ui.gift-list/GiftListFormPanel)}] 24 | :ident (fn [] [:component/id :home]) 25 | :initial-state {:ui/gift-list-form-panel {}} 26 | :route-segment ["home"] 27 | :will-enter (fn [_ _] 28 | (dr/route-immediate [:component/id :home]))} 29 | (dom/div {} 30 | (dom/h3 {} "Home Screen") 31 | (dom/div {} "Just getting started? Create a new gift list!") 32 | (ui.gift-list/ui-gift-list-form-panel gift-list-form-panel))) 33 | 34 | (defsc About [_this _] 35 | {:query [] 36 | :ident (fn [] [:component/id :home]) 37 | :initial-state {} 38 | :route-segment ["about"]} 39 | (dom/div {} 40 | (dom/h3 {} "About My Gift List") 41 | (dom/div {} "It's a really cool app!"))) 42 | 43 | (defn loading-spinner [] 44 | (dom/div :.ui.active.inverted.dimmer 45 | (dom/div :.ui.loader))) 46 | 47 | (defsc Loading [_this _] 48 | {:query [] 49 | :ident (fn [] [:component/id ::loading]) 50 | :initial-state {} 51 | :route-segment ["loading"]} 52 | (loading-spinner)) 53 | 54 | (defrouter MainRouter [_ _] 55 | {:router-targets [Loading LoginForm Home About ui.gift-list/GiftList]} 56 | (loading-spinner)) 57 | 58 | (def ui-main-router (comp/factory MainRouter)) 59 | 60 | (defsc Root [_this {:root/keys [router navbar left-nav loading] :as props}] 61 | {:query [{:root/router (comp/get-query MainRouter)} 62 | {:root/navbar (comp/get-query ui.nav/Navbar)} 63 | {:root/left-nav (comp/get-query ui.nav/LeftNav)} 64 | :root/loading 65 | {[:component/id :login-logout] 66 | [:ui/authenticated]}] 67 | :initial-state {:root/router {} 68 | :root/navbar {} 69 | :root/left-nav {} 70 | :root/loading true}} 71 | (let [authenticated (-> props 72 | (get [:component/id :login-logout]) 73 | :ui/authenticated)] 74 | (if loading 75 | (loading-spinner) 76 | (dom/div {} 77 | (ui.nav/ui-navbar navbar) 78 | (dom/div :.mgl_flex-container 79 | (when authenticated 80 | (ui.nav/ui-left-nav left-nav)) 81 | (dom/div :.ui.container 82 | (ui-main-router router))))))) 83 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Gift List App 2 | 3 | This is a work in progress web app that allows people to build and share gift lists. Invited participants can claim gifts without the creator knowing, similar to a baby or wedding registry. The development process is being documented on [my blog](https://chrisodonnell.dev); see the [introductory post](https://chrisodonnell.dev/posts/giftlist/intro/) for context. 4 | 5 | ## Setup 6 | 7 | In order to run this application, you need to have the following installed: 8 | * [node.js](https://docs.npmjs.com/downloading-and-installing-node-js-and-npm) 9 | * [java](https://adoptopenjdk.net/) 10 | * [clojure cli](https://clojure.org/guides/getting_started) 11 | * [docker](https://docs.docker.com/get-docker/) 12 | * [docker compose](https://docs.docker.com/compose/install/) 13 | 14 | With these installed, run 15 | ```bash 16 | npm install 17 | ``` 18 | 19 | to install javascript dependencies. 20 | 21 | ## Running 22 | 23 | ### Database 24 | 25 | We run a local postgres database inside docker-compose. To start the database, run 26 | ```bash 27 | docker-compose up -d 28 | ``` 29 | After starting the database, you'll need to run migrations, which you can do with 30 | ```bash 31 | make migrate 32 | ``` 33 | There's also a convenience script available at `./scripts/psql` to open up a psql client connected to the database. There are resources to learn more about working with a database inside docker compose in the [documentation](https://docs.docker.com/compose/). 34 | 35 | ### Application 36 | 37 | To run this application in development mode, start a shadow-cljs server with 38 | ```bash 39 | npx shadow-cljs -A:dev:backend:frontend:test -d nrepl:0.8.2 -d cider/piggieback:0.5.1 -d refactor-nrepl:2.5.0 -d cider/cider-nrepl:0.25.3 server 40 | ``` 41 | 42 | With this running, you can control compilation by accessing the shadow-cljs server at http://localhost:9630. In addition, this command will start up an nrepl server, which you should connect to with your preferred REPL. Alternatively, CIDER users can run `cider-jack-in-clj&cljs` and choose `shadow-cljs`. 43 | 44 | In your clojure repl, make sure you are in the `user` namespace and evaluate `(go)`. This will start our web server. With the web server running, you can access the application at http://localhost:3000. 45 | 46 | ## Tests 47 | 48 | To run the test suite from the command line, run 49 | ```bash 50 | make test 51 | ``` 52 | 53 | In order to run tests from the repl, you need to start up the test database. You can do this with 54 | ```bash 55 | make test-up 56 | ``` 57 | 58 | With the test database up and running, you should be able to run tests. You can shut down the test database with 59 | ```bash 60 | make test-down 61 | ``` 62 | 63 | ## Deployment 64 | 65 | To create an uberjar `target/mygiftlistrocks.jar` that includes production frontend assets, run 66 | ``` 67 | make uberjar 68 | ``` 69 | 70 | You can then run this uberjar with 71 | ``` 72 | java -cp target/mygiftlistrocks.jar clojure.main -m rocks.mygiftlist.main 73 | ``` 74 | 75 | You can run database migrations with 76 | ``` 77 | clojure -X:migrate :database-url '"postgresql://me:password@mydbhost:port/dbname"' 78 | ``` 79 | 80 | You can deploy to dokku with 81 | ``` 82 | git push dokku master 83 | ``` 84 | 85 | ## Maintenance 86 | 87 | To find outdated dependencies, you can run 88 | ``` 89 | make outdated 90 | ``` 91 | 92 | To create a build report documenting how large frontend dependencies are in your bundle, run 93 | ``` 94 | make build-report 95 | ``` 96 | -------------------------------------------------------------------------------- /src/cljs/rocks/mygiftlist/ui/gift_list.cljs: -------------------------------------------------------------------------------- 1 | (ns rocks.mygiftlist.ui.gift-list 2 | (:require 3 | [com.fulcrologic.fulcro.algorithms.form-state :as fs] 4 | [com.fulcrologic.fulcro.algorithms.merge :as merge] 5 | [com.fulcrologic.fulcro.components :as comp :refer [defsc]] 6 | [com.fulcrologic.fulcro.dom :as dom] 7 | [com.fulcrologic.fulcro.mutations :as m] 8 | 9 | [com.fulcrologic.semantic-ui.elements.button.ui-button :refer [ui-button]] 10 | [com.fulcrologic.semantic-ui.collections.form.ui-form :refer [ui-form]] 11 | [com.fulcrologic.semantic-ui.collections.form.ui-form-input :refer [ui-form-input]] 12 | 13 | [rocks.mygiftlist.type.gift-list :as gift-list] 14 | [rocks.mygiftlist.model.gift-list :as m.gift-list] 15 | [com.fulcrologic.fulcro.routing.dynamic-routing :as dr])) 16 | 17 | (declare GiftListForm) 18 | 19 | (defn- pristine-gift-list-form-state [] 20 | (fs/add-form-config 21 | GiftListForm 22 | #::gift-list {:id (random-uuid) 23 | :name ""})) 24 | 25 | (defsc GiftListForm [this 26 | {::gift-list/keys [name] :as gift-list} 27 | {:keys [reset-form!]}] 28 | {:ident ::gift-list/id 29 | :query [::gift-list/id ::gift-list/name fs/form-config-join] 30 | :initial-state (fn [_] (pristine-gift-list-form-state)) 31 | :form-fields #{::gift-list/name}} 32 | (let [validity (fs/get-spec-validity gift-list ::gift-list/name)] 33 | (ui-form 34 | {:onSubmit (fn [_] 35 | (if (= :valid validity) 36 | (do 37 | (comp/transact! this 38 | [(m.gift-list/create-gift-list 39 | (select-keys gift-list 40 | [::gift-list/id ::gift-list/name]))]) 41 | (reset-form!)) 42 | (comp/transact! this 43 | [(fs/mark-complete! {})])))} 44 | (ui-form-input 45 | {:placeholder "Birthday 2020" 46 | :onChange (fn [evt] 47 | (when (= :unchecked validity) 48 | (comp/transact! this 49 | [(fs/mark-complete! 50 | {:field ::gift-list/name})])) 51 | (m/set-string! this ::gift-list/name :event evt)) 52 | :error (when (= :invalid validity) 53 | "Gift list name cannot be blank") 54 | :autoFocus true 55 | :fluid true 56 | :value name}) 57 | (ui-button 58 | {:type "submit" 59 | :primary true 60 | :disabled (= :invalid validity)} 61 | "Submit")))) 62 | 63 | (def ui-gift-list-form (comp/factory GiftListForm)) 64 | 65 | (defsc GiftListFormPanel [this {:ui/keys [gift-list-form]}] 66 | {:ident (fn [] [:component/id :gift-list-form-panel]) 67 | :query [{:ui/gift-list-form (comp/get-query GiftListForm)}] 68 | :initial-state {:ui/gift-list-form {}}} 69 | (dom/div {} 70 | (ui-gift-list-form 71 | (comp/computed gift-list-form 72 | {:reset-form! #(merge/merge-component! this GiftListFormPanel 73 | {:ui/gift-list-form 74 | (pristine-gift-list-form-state)})})))) 75 | 76 | (def ui-gift-list-form-panel (comp/factory GiftListFormPanel)) 77 | 78 | (defsc GiftList [_this {::gift-list/keys [name]}] 79 | {:query [::gift-list/id ::gift-list/name] 80 | :ident ::gift-list/id 81 | :route-segment ["gift-list" ::gift-list/id] 82 | :will-enter (fn [_ {::gift-list/keys [id]}] 83 | (dr/route-immediate [::gift-list/id (uuid id)]))} 84 | (dom/div 85 | (dom/h3 name))) 86 | 87 | (def ui-gift-list (comp/factory GiftList)) 88 | -------------------------------------------------------------------------------- /deps.edn: -------------------------------------------------------------------------------- 1 | {:paths ["resources" "src/cljc"] 2 | :deps {com.fulcrologic/fulcro {:mvn/version "3.4.10" 3 | :exclusions [cljsjs/react 4 | cljsjs/react-dom 5 | cljsjs/react-dom-server 6 | org.clojure/clojurescript]} 7 | edn-query-language/eql {:mvn/version "1.0.1"} 8 | com.taoensso/timbre {:mvn/version "5.1.0"} 9 | org.clojure/core.async {:mvn/version "1.3.610"}} 10 | :aliases {:backend {:extra-paths ["src/clj"] 11 | :extra-deps {com.wsscode/pathom {:mvn/version "2.3.0"} 12 | com.cognitect/transit-clj {:mvn/version "1.0.324"} 13 | ring/ring-core {:mvn/version "1.8.2"} 14 | http-kit/http-kit {:mvn/version "2.5.0"} 15 | ring/ring-defaults {:mvn/version "0.3.2"} 16 | bk/ring-gzip {:mvn/version "0.3.0"} 17 | com.auth0/java-jwt {:mvn/version "3.12.0"} 18 | com.auth0/jwks-rsa {:mvn/version "0.15.0"} 19 | integrant/integrant {:mvn/version "0.8.0"} 20 | seancorfield/next.jdbc {:mvn/version "1.1.613"} 21 | honeysql/honeysql {:mvn/version "1.0.444"} 22 | nilenso/honeysql-postgres {:mvn/version "0.2.6"} 23 | org.postgresql/postgresql {:mvn/version "42.2.18"} 24 | hikari-cp/hikari-cp {:mvn/version "2.13.0"} 25 | aero/aero {:mvn/version "1.1.6"}}} 26 | :frontend {:extra-paths ["src/cljs"] 27 | :extra-deps {org.clojure/clojurescript {:mvn/version "1.10.773"} 28 | com.fulcrologic/semantic-ui-wrapper {:mvn/version "2.0.1"} 29 | com.cognitect/transit-cljs {:mvn/version "0.8.264"} 30 | com.wsscode/async {:mvn/version "1.0.13"} 31 | clj-commons/pushy {:mvn/version "0.3.10"} 32 | thheller/shadow-cljs {:mvn/version "2.11.10"}}} 33 | :dev {:extra-paths ["dev"] 34 | :jvm-opts ["-Dtrace"] 35 | :extra-deps {binaryage/devtools {:mvn/version "1.0.2"} 36 | integrant/repl {:mvn/version "0.3.2"}}} 37 | :test {:extra-paths ["test"] 38 | :extra-deps {com.cognitect/test-runner {:git/url "https://github.com/cognitect-labs/test-runner.git" 39 | :sha "b6b3193fcc42659d7e46ecd1884a228993441182"}}} 40 | :run-tests {:main-opts ["-m" "cognitect.test-runner"]} 41 | :migrate {:replace-paths ["migrate" "migrations"] 42 | ;; For some reason, depot doesn't detect 43 | ;; updated flyway versions. Update this 44 | ;; manually periodically. 45 | :replace-deps {org.flywaydb/flyway-core {:mvn/version "7.3.2"} 46 | org.postgresql/postgresql {:mvn/version "42.2.18"}} 47 | :exec-fn rocks.mygiftlist.migrate/migrate} 48 | :depstar {:extra-deps {seancorfield/depstar {:mvn/version "2.0.161"}} 49 | :ns-default hf.depstar 50 | :exec-args {}} 51 | :outdated {:extra-deps {olical/depot {:mvn/version "2.0.1"}} 52 | :main-opts ["-m" "depot.outdated.main"]}}} 53 | -------------------------------------------------------------------------------- /src/clj/rocks/mygiftlist/db.clj: -------------------------------------------------------------------------------- 1 | (ns rocks.mygiftlist.db 2 | (:require [rocks.mygiftlist.config :as config] 3 | [integrant.core :as ig] 4 | [hikari-cp.core :as pool] 5 | [next.jdbc :as jdbc] 6 | [next.jdbc.result-set :as result-set] 7 | [next.jdbc.prepare :as p] 8 | [clojure.string :as str] 9 | [honeysql.core :as sql] 10 | honeysql-postgres.format) 11 | (:import [java.net URI])) 12 | 13 | (defn database-url->datasource [database-url] 14 | (let [{:keys [userInfo host port path]} (bean (URI. database-url)) 15 | [username password] (str/split userInfo #":")] 16 | {:username username 17 | :password password 18 | :server-name host 19 | :port-number port 20 | :database-name (subs path 1)})) 21 | 22 | (defn datasource-options [{:keys [database-url sslmode]}] 23 | (merge {:auto-commit true 24 | :read-only false 25 | :connection-timeout 30000 26 | :validation-timeout 5000 27 | :idle-timeout 600000 28 | :max-lifetime 1800000 29 | :minimum-idle 10 30 | :maximum-pool-size 10 31 | :pool-name "db-pool" 32 | :adapter "postgresql" 33 | :register-mbeans false 34 | :sslmode sslmode} 35 | (database-url->datasource database-url))) 36 | 37 | (defmethod ig/init-key ::pool 38 | [_ {::config/keys [config]}] 39 | (pool/make-datasource (datasource-options 40 | (config/database-opts config)))) 41 | 42 | (defmethod ig/halt-key! ::pool 43 | [_ pool] 44 | (pool/close-datasource pool)) 45 | 46 | (defn- qualify 47 | "Given a kebab-case database table name, returns the namespace that 48 | attributes coming from that table should have." 49 | [table] 50 | (when (seq table) 51 | (str "rocks.mygiftlist.type." table))) 52 | 53 | (defn- snake->kebab [s] 54 | (str/replace s #"_" "-")) 55 | 56 | (defn- as-qualified-kebab-maps [rs opts] 57 | (result-set/as-modified-maps rs 58 | (assoc opts 59 | :qualifier-fn (comp qualify snake->kebab) 60 | :label-fn snake->kebab))) 61 | 62 | (def ^:private query-opts {:builder-fn as-qualified-kebab-maps}) 63 | 64 | (defn execute! [conn sql-map] 65 | (jdbc/execute! conn 66 | (sql/format sql-map :quoting :ansi) 67 | query-opts)) 68 | 69 | (defn execute-one! [conn sql-map] 70 | (jdbc/execute-one! conn 71 | (sql/format sql-map :quoting :ansi) 72 | query-opts)) 73 | 74 | (extend-protocol result-set/ReadableColumn 75 | 76 | ;; Automatically convert java.sql.Array into clojure vector in query 77 | ;; results 78 | java.sql.Array 79 | (read-column-by-label ^clojure.lang.PersistentVector 80 | [^java.sql.Array v _] 81 | (vec (.getArray v))) 82 | (read-column-by-index ^clojure.lang.PersistentVector 83 | [^java.sql.Array v _2 _3] 84 | (vec (.getArray v))) 85 | 86 | ;; Output java.time.LocalDate instead of java.sql.Date in query 87 | ;; results 88 | java.sql.Date 89 | (read-column-by-label ^java.time.LocalDate 90 | [^java.sql.Date v _] 91 | (.toLocalDate v)) 92 | (read-column-by-index ^java.time.LocalDate 93 | [^java.sql.Date v _2 _3] 94 | (.toLocalDate v)) 95 | 96 | ;; Output java.time.Instant instead of java.sql.Timestamp in query 97 | ;; results 98 | java.sql.Timestamp 99 | (read-column-by-label ^java.time.Instant 100 | [^java.sql.Timestamp v _] 101 | (.toInstant v)) 102 | (read-column-by-index ^java.time.Instant 103 | [^java.sql.Timestamp v _2 _3] 104 | (.toInstant v))) 105 | 106 | 107 | (extend-protocol p/SettableParameter 108 | 109 | ;; Accept java.time.Instant as a query param 110 | java.time.Instant 111 | (set-parameter 112 | [^java.time.Instant v ^java.sql.PreparedStatement ps ^long i] 113 | (.setTimestamp ps i (java.sql.Timestamp/from v))) 114 | 115 | ;; Accept java.time.LocalDate as a query param 116 | java.time.LocalDate 117 | (set-parameter 118 | [^java.time.LocalDate v ^java.sql.PreparedStatement ps ^long i] 119 | (.setTimestamp ps i (java.sql.Timestamp/valueOf (.atStartOfDay v))))) 120 | -------------------------------------------------------------------------------- /src/clj/rocks/mygiftlist/parser.clj: -------------------------------------------------------------------------------- 1 | (ns rocks.mygiftlist.parser 2 | (:require 3 | [taoensso.timbre :as log] 4 | [integrant.core :as ig] 5 | [com.wsscode.pathom.connect :as pc :refer [defresolver]] 6 | [com.wsscode.pathom.core :as p] 7 | [clojure.core.async :refer [ (get env ::pc/indexes) 19 | (update ::pc/index-resolvers 20 | #(into {} (map (fn [[k v]] [k (dissoc v ::pc/resolve)])) %)) 21 | (update ::pc/index-mutations 22 | #(into {} (map (fn [[k v]] [k (dissoc v ::pc/mutate)])) %)))}) 23 | 24 | (def all-resolvers [index-explorer 25 | m.user/user-resolvers 26 | m.gift-list/gift-list-resolvers]) 27 | 28 | (defn preprocess-parser-plugin 29 | "Helper to create a plugin that can view/modify the env/tx of a 30 | top-level request. 31 | f - (fn [{:keys [env tx]}] {:env new-env :tx new-tx}) 32 | If the function returns no env or tx, then the parser will not be 33 | called (aborts the parse)" 34 | [f] 35 | {::p/wrap-parser 36 | (fn transform-parser-out-plugin-external [parser] 37 | (fn transform-parser-out-plugin-internal [env tx] 38 | (let [{:keys [env tx]} (f {:env env :tx tx})] 39 | (if (and (map? env) (seq tx)) 40 | (parser env tx) 41 | {}))))}) 42 | 43 | (defn log-requests [{:keys [env tx] :as req}] 44 | (log/debug "Pathom transaction:" (pr-str tx)) 45 | (log/debug "Claims:" (-> env :ring/request ::auth/claims)) 46 | req) 47 | 48 | (defmethod ig/init-key ::parser 49 | [_ {::db/keys [pool]}] 50 | (let [real-parser 51 | (p/parallel-parser 52 | {::p/mutate pc/mutate-async 53 | ::p/env {::p/reader [p/map-reader 54 | pc/parallel-reader 55 | pc/open-ident-reader 56 | p/env-placeholder-reader] 57 | ::p/placeholder-prefixes #{">"}} 58 | ::p/plugins [(pc/connect-plugin {::pc/register all-resolvers}) 59 | (p/env-wrap-plugin 60 | (fn [env] 61 | ;; Here is where you can dynamically add 62 | ;; things to the resolver/mutation 63 | ;; environment, like the server config, 64 | ;; database connections, etc. 65 | (let [requester-auth0-id (get-in env [:ring/request ::auth/claims :sub])] 66 | (assoc env 67 | ::db/pool pool 68 | :requester-auth0-id requester-auth0-id 69 | :requester-id 70 | (and requester-auth0-id 71 | (::user/id (db/execute-one! pool 72 | {:select [:id] 73 | :from [:user] 74 | :where [:= requester-auth0-id :auth0_id]}))))))) 75 | (preprocess-parser-plugin log-requests) 76 | p/error-handler-plugin 77 | p/request-cache-plugin 78 | (p/post-process-parser-plugin p/elide-not-found) 79 | p/trace-plugin]}) 80 | ;; NOTE: Add -Dtrace to the server JVM to enable Fulcro 81 | ;; Inspect query performance traces to the network tab. 82 | ;; Understand that this makes the network responses much 83 | ;; larger and should not be used in production. 84 | trace? (some? (System/getProperty "trace"))] 85 | (fn wrapped-parser [env tx] 86 | ( {} 20 | addl-transit-handlers 21 | (assoc :handlers addl-transit-handlers) 22 | 23 | transit-transformation 24 | (assoc :transform transit-transformation)))] 25 | (fn [{:keys [headers] :as request}] 26 | (go 27 | (let [access-token (query ast) 107 | ok-handler (fn [result] 108 | (try 109 | (result-handler result) 110 | (catch :default e 111 | (log/error e "Result handler for remote" url "failed with an exception.")))) 112 | progress-handler (fn [update-msg] 113 | (let [msg {:status-code 200 114 | :raw-progress (select-keys update-msg [:progress-phase :progress-event]) 115 | :overall-progress (f.http/progress% update-msg :overall) 116 | :receive-progress (f.http/progress% update-msg :receiving) 117 | :send-progress (f.http/progress% update-msg :sending)}] 118 | (when update-handler 119 | (try 120 | (update-handler msg) 121 | (catch :default e 122 | (log/error e "Update handler for remote" url "failed with an exception.")))))) 123 | error-handler (fn [error-result] 124 | (try 125 | (result-handler (merge error-result {:status-code 500})) 126 | (catch :default e 127 | (log/error e "Error handler for remote" url "failed with an exception."))))] 128 | (let-chan [real-request (try 129 | (request-middleware {:headers {} :body edn :url url :method :post}) 130 | (catch :default e 131 | (log/error e "Send aborted due to middleware failure ") 132 | nil))] 133 | (if real-request 134 | (let [abort-id (or 135 | (-> send-node ::txn/options ::txn/abort-id) 136 | (-> send-node ::txn/options :abort-id)) 137 | xhrio (make-xhrio) 138 | {:keys [body headers url method response-type]} real-request 139 | http-verb (-> (or method :post) name str/upper-case) 140 | extract-response #(f.http/extract-response body real-request xhrio) 141 | extract-response-mw (f.http/response-extractor* response-middleware edn real-request xhrio) 142 | gc-network-resources (f.http/cleanup-routine* abort-id active-requests xhrio) 143 | progress-routine (f.http/progress-routine* extract-response progress-handler) 144 | ok-routine (f.http/ok-routine* progress-routine extract-response-mw ok-handler error-handler) 145 | error-routine (f.http/error-routine* extract-response-mw ok-routine progress-routine error-handler) 146 | with-cleanup (fn [f] (fn [evt] (try (f evt) (finally (gc-network-resources)))))] 147 | (when abort-id 148 | (swap! active-requests update abort-id (fnil conj #{}) xhrio)) 149 | (when (and (f.http/legal-response-types response-type) (not= :default response-type)) 150 | (.setResponseType ^js xhrio (get f.http/response-types response-type))) 151 | (when progress-handler 152 | (f.http/xhrio-enable-progress-events xhrio) 153 | (events/listen xhrio (.-DOWNLOAD_PROGRESS ^js EventType) #(progress-routine :receiving %)) 154 | (events/listen xhrio (.-UPLOAD_PROGRESS ^js EventType) #(progress-routine :sending %))) 155 | (events/listen xhrio (.-SUCCESS ^js EventType) (with-cleanup ok-routine)) 156 | (events/listen xhrio (.-ABORT ^js EventType) (with-cleanup #(ok-handler {:status-text "Cancelled" 157 | ::txn/aborted? true}))) 158 | (events/listen xhrio (.-ERROR ^js EventType) (with-cleanup error-routine)) 159 | (f.http/xhrio-send xhrio url http-verb body headers)) 160 | (error-handler {:error :abort :error-text "Transmission was aborted because the request middleware returned nil or threw an exception"})))))) 161 | :abort! (fn abort! [this id] 162 | (if-let [xhrios (get @(:active-requests this) id)] 163 | (doseq [xhrio xhrios] 164 | (f.http/xhrio-abort xhrio)) 165 | (log/info "Unable to abort. No active request with abort id:" id)))})) 166 | --------------------------------------------------------------------------------