├── .gitattributes ├── .github └── FUNDING.yml ├── .gitignore ├── CHANGELOG.md ├── LICENSE ├── README.md ├── bb.edn ├── cljfmt-indents.edn ├── deps.edn ├── libs ├── config │ ├── deps.edn │ └── src │ │ └── com │ │ └── biffweb │ │ └── config.clj ├── task-runner │ ├── deps.edn │ └── src │ │ └── com │ │ └── biffweb │ │ ├── task_runner.clj │ │ └── task_runner │ │ ├── lazy.clj │ │ └── lazy │ │ └── clojure │ │ └── string.clj ├── tasks │ ├── deps.edn │ └── src │ │ └── com │ │ └── biffweb │ │ ├── tasks.clj │ │ └── tasks │ │ └── lazy │ │ ├── babashka │ │ ├── fs.clj │ │ └── process.clj │ │ ├── clojure │ │ ├── java │ │ │ ├── io.clj │ │ │ └── shell.clj │ │ ├── stacktrace.clj │ │ ├── string.clj │ │ └── tools │ │ │ └── build │ │ │ └── api.clj │ │ ├── com │ │ └── biffweb │ │ │ └── config.clj │ │ ├── hato │ │ └── client.clj │ │ ├── nextjournal │ │ └── beholder.clj │ │ └── nrepl │ │ └── cmdline.clj └── xtdb-mock │ ├── deps.edn │ └── src │ └── xtdb │ └── api.clj ├── new-project.clj ├── src └── com │ ├── biffweb.clj │ └── biffweb │ └── impl │ ├── auth.clj │ ├── htmx_refresh.clj │ ├── middleware.clj │ ├── misc.clj │ ├── queues.clj │ ├── rum.clj │ ├── time.clj │ ├── util.clj │ ├── util │ ├── ns.clj │ ├── reload.clj │ └── s3.clj │ └── xtdb.clj ├── starter ├── .dockerignore ├── .gitignore ├── Dockerfile ├── README.md ├── cljfmt-indents.edn ├── deps.edn ├── dev │ ├── repl.clj │ └── tasks.clj ├── resources │ ├── config.edn │ ├── config.template.env │ ├── fixtures.edn │ ├── public │ │ ├── img │ │ │ └── glider.png │ │ └── js │ │ │ └── main.js │ ├── tailwind.config.js │ └── tailwind.css ├── server-setup.sh ├── src │ └── com │ │ ├── example.clj │ │ └── example │ │ ├── app.clj │ │ ├── email.clj │ │ ├── home.clj │ │ ├── middleware.clj │ │ ├── schema.clj │ │ ├── settings.clj │ │ ├── ui.clj │ │ └── worker.clj └── test │ └── com │ └── example_test.clj ├── tasks ├── deps.edn └── src │ └── com │ └── biffweb │ └── tasks.clj └── test └── com └── biffweb └── impl ├── middleware_test.clj └── xtdb_test.clj /.gitattributes: -------------------------------------------------------------------------------- 1 | * linguist-vendored 2 | *.clj* linguist-vendored=false 3 | -------------------------------------------------------------------------------- /.github/FUNDING.yml: -------------------------------------------------------------------------------- 1 | github: [jacobobryant] 2 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | pom.xml 2 | pom.xml.asc 3 | *.jar 4 | *.class 5 | /lib/ 6 | /classes/ 7 | /target/ 8 | /checkouts/ 9 | .lein-deps-sum 10 | .lein-repl-history 11 | .lein-plugins/ 12 | .lein-failures 13 | .nrepl-port 14 | .cpcache/ 15 | data/ 16 | site/ 17 | .firebase/ 18 | .calva/ 19 | .clj-kondo/ 20 | .lsp/ 21 | .portal/ -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | See [GitHub releases](https://github.com/jacobobryant/biff/releases) for significant releases. Some 2 | patch versions are only documented in the git commit log until the next release is published. 3 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2024 Jacob O'Bryant 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Biff 2 | 3 | A Clojure web framework for solo developers. See [biffweb.com](https://biffweb.com). 4 | 5 | ## Contributing 6 | 7 | Documentation source is located at [github.com/jacobobryant/biffweb.com](https://github.com/jacobobryant/biffweb.com), 8 | under `content/docs`. Feel free to submit corrections. 9 | 10 | Also check out the [content library](https://biffweb.com/docs/library/). If you write an experience report, how-to guide (could be as simple 11 | as pasting some code into a gist) or other Biff-related blog post, I'll add it there. 12 | 13 | PRs for the code are also welcome. To hack on Biff, either run `bb dev` or `cd starter; clj -M:dev dev`. (The starter 14 | project's deps.edn declares a local dependency on the Biff library code.) 15 | 16 | Finally, check out [the roadmap](https://github.com/users/jacobobryant/projects/2). These are the main tasks I'm planning to work on myself, and many of them are 17 | exploratory. If any of them look interesting to you, I'd be happy to chat more. 18 | 19 | ## Sponsors 20 | 21 | Thanks to [JUXT](https://juxt.pro), [Clojurists Together](https://www.clojuriststogether.org/) and [other 22 | individuals](https://github.com/sponsors/jacobobryant) for sponsoring Biff! 23 | -------------------------------------------------------------------------------- /bb.edn: -------------------------------------------------------------------------------- 1 | {:tasks {dev (clojure "-M:dev") 2 | format (clojure "-M:format") 3 | lint (shell "clj-kondo" "--lint" "src") 4 | postgres (shell "docker" "run" "--rm" 5 | "-e" "POSTGRES_DB=main" 6 | "-e" "POSTGRES_USER=foo" 7 | "-e" "POSTGRES_PASSWORD=bar" 8 | "-p" "5432:5432" 9 | "-v" "/home/jacob/dev/biff/target/postgres:/var/lib/postgresql/data" 10 | "postgres")}} 11 | -------------------------------------------------------------------------------- /cljfmt-indents.edn: -------------------------------------------------------------------------------- 1 | {submit-tx [[:inner 0]]} 2 | -------------------------------------------------------------------------------- /deps.edn: -------------------------------------------------------------------------------- 1 | {:paths ["src"] 2 | :deps {better-cond/better-cond {:mvn/version "2.1.4"} 3 | buddy/buddy-sign {:mvn/version "3.4.333"} 4 | cider/cider-nrepl {:mvn/version "0.51.1"} 5 | clj-http/clj-http {:mvn/version "3.12.3"} 6 | com.nextjournal/beholder {:mvn/version "1.0.2"} 7 | com.xtdb/xtdb-core {:mvn/version "1.23.1"} 8 | com.xtdb/xtdb-jdbc {:mvn/version "1.23.1"} 9 | com.xtdb/xtdb-rocksdb {:mvn/version "1.23.1"} 10 | info.sunng/ring-jetty9-adapter {:mvn/version "0.17.2"} 11 | jarohen/chime {:mvn/version "0.3.3"} 12 | lambdaisland/uri {:mvn/version "1.13.95"} 13 | metosin/malli {:mvn/version "0.16.1"} 14 | metosin/muuntaja {:mvn/version "0.6.8"} 15 | metosin/reitit-ring {:mvn/version "0.6.0"} 16 | nrepl/nrepl {:mvn/version "1.3.1"} 17 | org.clojure/tools.deps.alpha {:git/url "https://github.com/clojure/tools.deps.alpha" 18 | :sha "8f8fc2571e721301b6d52e191129248355cb8c5a"} 19 | org.clojure/tools.logging {:mvn/version "1.2.4"} 20 | org.clojure/tools.namespace {:mvn/version "1.4.4"} 21 | org.postgresql/postgresql {:mvn/version "42.6.0"} 22 | refactor-nrepl/refactor-nrepl {:mvn/version "3.6.0"} 23 | ring/ring-defaults {:mvn/version "0.3.4"} 24 | rum/rum {:mvn/version "0.12.11" 25 | :exclusions [cljsjs/react cljsjs/react-dom]} 26 | com.biffweb/config {:git/url "https://github.com/jacobobryant/biff" 27 | :git/tag "v0.7.25" 28 | :git/sha "7e920b2" 29 | :deps/root "libs/config"} 30 | ;; deprecated 31 | hawk/hawk {:mvn/version "0.2.11"}} 32 | :aliases {:dev {:extra-paths ["test"] 33 | :extra-deps {org.slf4j/slf4j-simple {:mvn/version "2.0.0-alpha5"}} 34 | :main-opts ["-m" "nrepl.cmdline"]} 35 | :format {:extra-deps {cljfmt/cljfmt {:mvn/version "0.8.2"}} 36 | :main-opts ["-m" "cljfmt.main" "fix" "--indents" "cljfmt-indents.edn"]}}} 37 | -------------------------------------------------------------------------------- /libs/config/deps.edn: -------------------------------------------------------------------------------- 1 | {:deps {aero/aero {:mvn/version "1.1.6"}}} 2 | -------------------------------------------------------------------------------- /libs/config/src/com/biffweb/config.clj: -------------------------------------------------------------------------------- 1 | (ns com.biffweb.config 2 | (:require [aero.core :as aero] 3 | [clojure.java.io :as io] 4 | [clojure.string :as str])) 5 | 6 | ;;;; Copied from com.biffweb.impl.* -------------------------------------------- 7 | (defn- ns-parts [nspace] 8 | (if (empty? (str nspace)) 9 | [] 10 | (str/split (str nspace) #"\."))) 11 | 12 | (defn- select-ns [m nspace] 13 | (let [parts (ns-parts nspace)] 14 | (->> (keys m) 15 | (filterv (fn [k] 16 | (= parts (take (count parts) (ns-parts (namespace k)))))) 17 | (select-keys m)))) 18 | 19 | (defn- select-ns-as [m ns-from ns-to] 20 | (into {} 21 | (map (fn [[k v]] 22 | (let [new-ns-parts (->> (ns-parts (namespace k)) 23 | (drop (count (ns-parts ns-from))) 24 | (concat (ns-parts ns-to)))] 25 | [(if (empty? new-ns-parts) 26 | (keyword (name k)) 27 | (keyword (str/join "." new-ns-parts) (name k))) 28 | v]))) 29 | (select-ns m ns-from))) 30 | 31 | (defmacro catchall 32 | [& body] 33 | `(try ~@body (catch Exception ~'_ nil))) 34 | ;;;; --------------------------------------------------------------------------- 35 | 36 | ;; Algorithm adapted from dotenv-java: 37 | ;; https://github.com/cdimascio/dotenv-java/blob/master/src/main/java/io/github/cdimascio/dotenv/internal/DotenvParser.java 38 | ;; Wouldn't hurt to take a more thorough look at Ruby dotenv's algorithm: 39 | ;; https://github.com/bkeepers/dotenv/blob/master/lib/dotenv/parser.rb 40 | (defn parse-env-var [line] 41 | (let [line (str/trim line) 42 | [_ _ k v] (re-matches #"^\s*(export\s+)?([\w.\-]+)\s*=\s*(['][^']*[']|[\"][^\"]*[\"]|[^#]*)?\s*(#.*)?$" 43 | line)] 44 | (when-not (or (str/starts-with? line "#") 45 | (str/starts-with? line "////") 46 | (empty? v)) 47 | (let [v (str/trim v) 48 | v (if (or (re-matches #"^\".*\"$" v) 49 | (re-matches #"^'.*'$" v)) 50 | (subs v 1 (dec (count v))) 51 | v)] 52 | [k v])))) 53 | 54 | (defmethod aero/reader 'biff/env 55 | [{:keys [profile biff.aero/env] :as opts} _ value] 56 | (not-empty (get env (str value)))) 57 | 58 | (defmethod aero/reader 'biff/secret 59 | [{:keys [profile biff.aero/env] :as opts} _ value] 60 | (when-some [value (aero/reader opts 'biff/env value)] 61 | (fn [] value))) 62 | 63 | (defn get-env [] 64 | (reduce into 65 | {} 66 | [(some->> (catchall (slurp "config.env")) 67 | str/split-lines 68 | (keep parse-env-var)) 69 | (System/getenv) 70 | (keep (fn [[k v]] 71 | (when (str/starts-with? k "biff.env.") 72 | [(str/replace k #"^biff.env." "") v])) 73 | (System/getProperties))])) 74 | 75 | (defn use-aero-config [{:biff.config/keys [skip-validation profile] :as ctx}] 76 | (let [env (get-env) 77 | profile (some-> (or profile 78 | (get env "BIFF_PROFILE") 79 | ;; For backwards compatibility 80 | (get env "BIFF_ENV")) 81 | keyword) 82 | ctx (merge ctx (aero/read-config (io/resource "config.edn") {:profile profile :biff.aero/env env})) 83 | secret (fn [k] 84 | (some-> (get ctx k) (.invoke))) 85 | ctx (assoc ctx :biff/secret secret)] 86 | (when-not (or skip-validation 87 | (and (secret :biff.middleware/cookie-secret) 88 | (secret :biff/jwt-secret))) 89 | (binding [*out* *err*] 90 | (println "Secrets are missing. Make sure you have a config.env file in the current " 91 | "directory, or set config via environment variables.") 92 | (System/exit 1))) 93 | (doseq [[k v] (select-ns-as ctx 'biff.system-properties nil)] 94 | (System/setProperty (name k) v)) 95 | ctx)) 96 | -------------------------------------------------------------------------------- /libs/task-runner/deps.edn: -------------------------------------------------------------------------------- 1 | {:paths ["src"]} 2 | -------------------------------------------------------------------------------- /libs/task-runner/src/com/biffweb/task_runner.clj: -------------------------------------------------------------------------------- 1 | (ns com.biffweb.task-runner 2 | (:require [com.biffweb.task-runner.lazy.clojure.string :as str])) 3 | 4 | (def tasks {}) 5 | 6 | (defn- print-help [tasks] 7 | (let [col-width (apply max (mapv count (keys tasks)))] 8 | (println "Available commands:") 9 | (println) 10 | (doseq [[task-name task-var] (sort-by key tasks) 11 | :let [doc (some-> (:doc (meta task-var)) 12 | str/split-lines 13 | first)]] 14 | (printf (str " %-" col-width "s%s\n") 15 | task-name 16 | (if doc 17 | (str " - " doc) 18 | ""))))) 19 | 20 | (defn- print-help-for [task-fn] 21 | (let [{:keys [doc] :or {doc ""}} (meta task-fn) 22 | lines (str/split-lines doc) 23 | indent (some->> lines 24 | rest 25 | (remove (comp empty? str/trim)) 26 | not-empty 27 | (mapv #(count (take-while #{\ } %))) 28 | (apply min)) 29 | doc (str (first lines) "\n" 30 | (->> (rest lines) 31 | (map #(subs % (min (count %) indent))) 32 | (str/join "\n")))] 33 | (println doc))) 34 | 35 | (defn run-task [task-name & args] 36 | (let [task-fn (get tasks task-name)] 37 | (cond 38 | (nil? task-fn) 39 | (binding [*out* *err*] 40 | (println (str "Unrecognized task: " task-name)) 41 | (System/exit 1)) 42 | 43 | (#{"help" "--help" "-h"} (first args)) 44 | (print-help-for task-fn) 45 | 46 | :else 47 | (apply task-fn args)))) 48 | 49 | (defn -main 50 | ([tasks-sym] 51 | (-main tasks-sym "--help")) 52 | ([tasks-sym task-name & args] 53 | (let [tasks @(requiring-resolve (symbol tasks-sym))] 54 | (if (contains? #{"help" "--help" "-h" nil} task-name) 55 | (print-help tasks) 56 | (do 57 | (alter-var-root #'tasks (constantly tasks)) 58 | (apply run-task task-name args))) 59 | (shutdown-agents)))) 60 | -------------------------------------------------------------------------------- /libs/task-runner/src/com/biffweb/task_runner/lazy.clj: -------------------------------------------------------------------------------- 1 | (ns com.biffweb.task-runner.lazy 2 | (:refer-clojure :exclude [refer])) 3 | 4 | (defmacro refer [sym & [sym-alias]] 5 | (let [sym-alias (or sym-alias (symbol (name sym)))] 6 | `(defn ~sym-alias [& args#] 7 | (apply (requiring-resolve '~sym) args#)))) 8 | 9 | (defmacro refer-many [& args] 10 | `(do 11 | ~@(for [[ns-sym fn-syms] (partition 2 args) 12 | fn-sym fn-syms] 13 | `(refer ~(symbol (name ns-sym) (name fn-sym)))))) 14 | -------------------------------------------------------------------------------- /libs/task-runner/src/com/biffweb/task_runner/lazy/clojure/string.clj: -------------------------------------------------------------------------------- 1 | (ns com.biffweb.task-runner.lazy.clojure.string 2 | (:refer-clojure :exclude [replace]) 3 | (:require [com.biffweb.task-runner.lazy :as lazy])) 4 | 5 | (lazy/refer-many clojure.string [includes? join lower-case split split-lines trim replace]) 6 | -------------------------------------------------------------------------------- /libs/tasks/deps.edn: -------------------------------------------------------------------------------- 1 | {:deps {com.biffweb/config {:git/url "https://github.com/jacobobryant/biff" 2 | :git/tag "v0.7.25" 3 | :git/sha "7e920b2" 4 | :deps/root "libs/config"} 5 | com.biffweb/task-runner {:git/url "https://github.com/jacobobryant/biff" 6 | :git/sha "bb1feb6f68f42ac3faa02c8c15b31aa21037dc63" 7 | :deps/root "libs/task-runner"} 8 | babashka/fs {:mvn/version "0.5.20"} 9 | babashka/process {:mvn/version "0.5.21"} 10 | cider/cider-nrepl {:mvn/version "0.28.3"} 11 | com.nextjournal/beholder {:mvn/version "1.0.2"} 12 | hato/hato {:mvn/version "0.9.0"} 13 | io.github.clojure/tools.build {:git/tag "v0.9.6" :git/sha "8e78bcc"} 14 | nrepl/nrepl {:mvn/version "1.0.0"} 15 | refactor-nrepl/refactor-nrepl {:mvn/version "3.6.0"}} 16 | :paths ["src"]} 17 | -------------------------------------------------------------------------------- /libs/tasks/src/com/biffweb/tasks.clj: -------------------------------------------------------------------------------- 1 | (ns com.biffweb.tasks 2 | "A collection of tasks used by Biff projects." 3 | (:refer-clojure :exclude [future]) 4 | (:require [com.biffweb.task-runner :refer [run-task]] 5 | [com.biffweb.tasks.lazy.clojure.java.io :as io] 6 | [com.biffweb.tasks.lazy.clojure.java.shell :as sh] 7 | [com.biffweb.tasks.lazy.clojure.string :as str] 8 | [com.biffweb.tasks.lazy.babashka.fs :as fs] 9 | [com.biffweb.tasks.lazy.babashka.process :as process] 10 | [com.biffweb.tasks.lazy.com.biffweb.config :as config] 11 | [com.biffweb.tasks.lazy.clojure.stacktrace :as st] 12 | [com.biffweb.tasks.lazy.hato.client :as hato] 13 | [com.biffweb.tasks.lazy.nrepl.cmdline :as nrepl-cmd] 14 | [com.biffweb.tasks.lazy.nextjournal.beholder :as beholder] 15 | [com.biffweb.tasks.lazy.clojure.tools.build.api :as clj-build]) 16 | (:import [java.util Timer TimerTask])) 17 | 18 | ;; https://gist.github.com/oliyh/0c1da9beab43766ae2a6abc9507e732a 19 | (defn- debounce 20 | ([f] (debounce f 1000)) 21 | ([f timeout] 22 | (let [timer (Timer.) 23 | task (atom nil)] 24 | (with-meta 25 | (fn [& args] 26 | (when-let [t ^TimerTask @task] 27 | (.cancel t)) 28 | (let [new-task (proxy [TimerTask] [] 29 | (run [] 30 | (apply f args) 31 | (reset! task nil) 32 | (.purge timer)))] 33 | (reset! task new-task) 34 | (.schedule timer new-task timeout))) 35 | {:task-atom task})))) 36 | 37 | (defmacro future [& body] 38 | `(clojure.core/future 39 | (try 40 | ~@body 41 | (catch Exception e# 42 | (binding [*err* *out*] 43 | (st/print-stack-trace e#)))))) 44 | 45 | (def ^:private ^:dynamic *shell-env* nil) 46 | 47 | (defn- windows? [] 48 | (-> (System/getProperty "os.name") 49 | (str/lower-case) 50 | (str/includes? "windows"))) 51 | 52 | (defn- shell 53 | "Difference between this and clojure.java.shell/sh: 54 | 55 | - inherits std{in,out,err} 56 | - throws on non-zero exit code 57 | - puts *shell-env* in the environment" 58 | [& args] 59 | (apply process/shell {:extra-env *shell-env*} args)) 60 | 61 | (defn- sh-success? [& args] 62 | (try 63 | (= 0 (:exit (apply sh/sh args))) 64 | (catch Exception _ 65 | false))) 66 | 67 | (defn- get-env-from [cmd] 68 | (let [{:keys [exit out]} (sh/sh "sh" "-c" (str cmd "; printenv"))] 69 | (when (= 0 exit) 70 | (->> out 71 | str/split-lines 72 | (map #(vec (str/split % #"=" 2))) 73 | (filter #(= 2 (count %))) 74 | (into {}))))) 75 | 76 | (defn- with-ssh-agent* [{:keys [biff.tasks/skip-ssh-agent]} f] 77 | (if-let [env (and (not skip-ssh-agent) 78 | (fs/which "ssh-agent") 79 | (not (sh-success? "ssh-add" "-l")) 80 | (nil? *shell-env*) 81 | (if (windows?) 82 | {} 83 | (get-env-from "eval $(ssh-agent)")))] 84 | (binding [*shell-env* env] 85 | (try 86 | (try 87 | (shell "ssh-add") 88 | (println "Started an ssh-agent session. If you set up `keychain`, you won't have to enter your password" 89 | "each time you run this command: https://www.funtoo.org/Funtoo:Keychain") 90 | (catch Exception e 91 | (binding [*out* *err*] 92 | (st/print-stack-trace e) 93 | (println "\nssh-add failed. You may have to enter your password multiple times. You can avoid this if you set up `keychain`:" 94 | "https://www.funtoo.org/Funtoo:Keychain")))) 95 | (f) 96 | (finally 97 | (sh/sh "ssh-agent" "-k" :env *shell-env*)))) 98 | (f))) 99 | 100 | (defmacro with-ssh-agent [ctx & body] 101 | `(with-ssh-agent* ~ctx (fn [] ~@body))) 102 | 103 | (defn- new-secret [length] 104 | (let [buffer (byte-array length)] 105 | (.nextBytes (java.security.SecureRandom/getInstanceStrong) buffer) 106 | (.encodeToString (java.util.Base64/getEncoder) buffer))) 107 | 108 | (defn- ssh-run [{:keys [biff.tasks/server]} & args] 109 | (apply shell "ssh" (str "app@" server) args)) 110 | 111 | (defn- local-bun-path [] 112 | (some-> (fs/which "bun") str)) 113 | 114 | (defn- install-js-deps-cmd [] 115 | (cond 116 | (fs/exists? "bun.lockb") "bun install" 117 | :else "npm install")) 118 | 119 | (defn- local-tailwind-path [] 120 | (if (windows?) 121 | "bin/tailwindcss.exe" 122 | "bin/tailwindcss")) 123 | 124 | (defn- infer-tailwind-file [] 125 | (let [os-name (str/lower-case (System/getProperty "os.name")) 126 | os-type (cond 127 | (str/includes? os-name "windows") "windows" 128 | (str/includes? os-name "linux") "linux" 129 | :else "macos") 130 | arch (case (System/getProperty "os.arch") 131 | ("amd64" "x86_64") "x64" 132 | "arm64")] 133 | (str "tailwindcss-" os-type "-" arch (when (= os-type "windows") ".exe")))) 134 | 135 | (defn- push-files-rsync [{:biff.tasks/keys [server deploy-untracked-files]}] 136 | (let [files (->> (:out (sh/sh "git" "ls-files")) 137 | str/split-lines 138 | (map #(str/replace % #"/.*" "")) 139 | distinct 140 | (concat deploy-untracked-files) 141 | (filter fs/exists?))] 142 | (when (and (not (windows?)) (fs/exists? "config.env")) 143 | (fs/set-posix-file-permissions "config.env" "rw-------")) 144 | (->> (concat ["rsync" "--archive" "--verbose" "--relative" "--include='**.gitignore'" 145 | "--exclude='/.git'" "--filter=:- .gitignore" "--delete-after" "--protocol=29"] 146 | files 147 | [(str "app@" server ":")]) 148 | (apply shell)))) 149 | 150 | (defn- push-files-git [{:biff.tasks/keys [deploy-cmd 151 | git-deploy-cmd 152 | deploy-from 153 | deploy-to 154 | deploy-untracked-files 155 | server]}] 156 | (when-some [files (not-empty (filterv fs/exists? deploy-untracked-files))] 157 | (when-some [dirs (not-empty (keep (comp not-empty fs/parent) files))] 158 | (apply shell "ssh" (str "app@" server) "mkdir" "-p" dirs)) 159 | (doseq [file files] 160 | (shell "scp" file (str "app@" server ":" file)))) 161 | ;; deploy-cmd, deploy-from, and deploy-to are all deprecated (but still supported for backwards compatibility) 162 | (if-some [git-deploy-cmd (or git-deploy-cmd deploy-cmd)] 163 | (apply shell git-deploy-cmd) 164 | (shell "git" "push" deploy-to deploy-from))) 165 | 166 | (defn- push-files [{:keys [biff.tasks/deploy-with] :as ctx}] 167 | (let [deploy-with (or deploy-with 168 | (if (fs/which "rsync") 169 | :rsync 170 | :git))] 171 | (case deploy-with 172 | :rsync (push-files-rsync ctx) 173 | :git (push-files-git ctx) 174 | (binding [*out* *err*] 175 | (println "Unrecognized config option `:biff.tasks/deploy-with " deploy-with "`. Valid options are " 176 | ":rsync and :git") 177 | (System/exit 2))))) 178 | 179 | (defn- auto-soft-deploy [{:biff.tasks/keys [watch-dirs] 180 | :or {watch-dirs ["src" "dev" "resources" "test"]} 181 | :as ctx}] 182 | (run-task "soft-deploy") 183 | (apply beholder/watch 184 | (debounce (fn [_] 185 | (run-task "soft-deploy")) 186 | 500) 187 | watch-dirs)) 188 | 189 | (def ^:private config (delay (config/use-aero-config {:biff.config/skip-validation true}))) 190 | 191 | ;;;; TASKS ===================================================================== 192 | 193 | (defn clean 194 | "Deletes generated files" 195 | [] 196 | (clj-build/delete {:path "target"})) 197 | 198 | (defn install-tailwind 199 | "Downloads a Tailwind binary to bin/tailwindcss." 200 | [& [file]] 201 | (let [{:biff.tasks/keys [tailwind-build tailwind-version]} @config 202 | [file inferred] (or (when file 203 | [file false]) 204 | ;; Backwards compatibility. 205 | (when tailwind-build 206 | [(str "tailwindcss-" tailwind-build) false]) 207 | [(infer-tailwind-file) true]) 208 | url (str "https://github.com/tailwindlabs/tailwindcss/releases/" 209 | (if tailwind-version 210 | (str "download/" tailwind-version) 211 | "latest/download") 212 | "/" 213 | file) 214 | dest (io/file (local-tailwind-path))] 215 | (io/make-parents dest) 216 | (println "Downloading" 217 | (or tailwind-version "the latest version") 218 | "of" file "...") 219 | (when inferred 220 | (println "If that's the wrong file, run `clj -M:dev install-tailwind `")) 221 | (println) 222 | (println "After the download finishes, you can avoid downloading Tailwind again for" 223 | "future projects if you copy it to your path, e.g. by running:") 224 | (println " sudo cp" (local-tailwind-path) "/usr/local/bin/tailwindcss") 225 | (println) 226 | (io/copy (:body (hato/get url {:as :stream :http-client {:redirect-policy :normal}})) dest) 227 | (.setExecutable dest true))) 228 | 229 | (defn- bun-pkg-installed? [package-name] 230 | (and (fs/which "bun") 231 | (str/includes? (:out (sh/sh "bun" "pm" "ls")) 232 | package-name))) 233 | 234 | (defn- tailwind-installation-info [] 235 | (let [local-bin-installed (fs/exists? (local-tailwind-path))] 236 | {:local-bin-installed local-bin-installed 237 | :tailwind-cmd 238 | (cond 239 | (bun-pkg-installed? "tailwindcss") :bun 240 | (sh-success? "npm" "list" "tailwindcss") :npm 241 | (and (fs/which "tailwindcss") (not local-bin-installed)) :global-bin 242 | :else :local-bin)})) 243 | 244 | (defn css 245 | "Generates the target/resources/public/css/main.css file. 246 | 247 | The logic for running and installing Tailwind is: 248 | 249 | 1. If tailwindcss has been installed via npm or bun, then that installation 250 | will be used. 251 | 252 | 2. Otherwise, if the tailwindcss standalone binary has been downloaded to 253 | ./bin/, that will be used. 254 | 255 | 3. Otherwise, if the tailwindcss standalone binary has been installed to the 256 | path (e.g. /usr/local/bin/tailwindcss), that will be used. 257 | 258 | 4. Otherwise, the tailwindcss standalone binary will be downloaded to ./bin/, 259 | and that will be used." 260 | [& tailwind-args] 261 | (let [{:biff.tasks/keys [css-output] :as ctx} @config 262 | {:keys [local-bin-installed tailwind-cmd]} (tailwind-installation-info)] 263 | (when (and (= tailwind-cmd :local-bin) (not local-bin-installed)) 264 | (run-task "install-tailwind")) 265 | (when (= tailwind-cmd :local-bin) 266 | ;; This normally will be handled by install-tailwind, but we set it here in case that function 267 | ;; was interrupted. Assuming the download was incomplete, the 139 exit code (segfault) handler will be 268 | ;; triggered below. I've also had a report of exit code 137 (sigkill) being triggered. 269 | (.setExecutable (io/file (local-tailwind-path)) true)) 270 | (try 271 | (apply shell (concat (case tailwind-cmd 272 | :npm ["npx" "tailwindcss"] 273 | :bun ["bunx" "tailwindcss"] 274 | :global-bin [(str (fs/which "tailwindcss"))] 275 | :local-bin [(local-tailwind-path)]) 276 | ["-c" "resources/tailwind.config.js" 277 | "-i" "resources/tailwind.css" 278 | "-o" css-output] 279 | tailwind-args)) 280 | (catch Exception e 281 | (if (and (#{137 139} (:exit (ex-data e))) 282 | (#{:local-bin :global-bin} tailwind-cmd)) 283 | (binding [*out* *err*] 284 | (println "It looks like your Tailwind installation is corrupted. Try deleting it and running this command again:") 285 | (println) 286 | (println " rm" (if (= tailwind-cmd :local-bin) 287 | (local-tailwind-path) 288 | (str (fs/which "tailwindcss")))) 289 | (println)) 290 | (throw e)))))) 291 | 292 | (defn dev 293 | "Starts the app locally. 294 | 295 | After running, wait for the `System started` message. Connect your editor to 296 | nrepl port 7888 (by default). Whenever you save a file, Biff will: 297 | 298 | - Evaluate any changed Clojure files 299 | - Regenerate static HTML and CSS files 300 | - Run tests" 301 | [] 302 | (if-not (fs/exists? "target/resources") 303 | ;; This is an awful hack. We have to run the app in a new process, otherwise 304 | ;; target/resources won't be included in the classpath. Downside of not 305 | ;; using bb tasks anymore -- no longer have a lightweight parent process 306 | ;; that can create the directory before starting the JVM. 307 | (do 308 | (io/make-parents "target/resources/_") 309 | (shell "clj" "-M:dev" "dev")) 310 | (let [{:keys [biff.tasks/main-ns biff.nrepl/port] :as ctx} @config] 311 | (when-not (fs/exists? "config.env") 312 | (run-task "generate-config")) 313 | (when (fs/exists? "package.json") 314 | (shell (install-js-deps-cmd))) 315 | (let [{:keys [local-bin-installed tailwind-cmd]} (tailwind-installation-info)] 316 | (when (and (= tailwind-cmd :local-bin) (not local-bin-installed)) 317 | (run-task "install-tailwind"))) 318 | (future (run-task "css" "--watch")) 319 | (spit ".nrepl-port" port) 320 | ((requiring-resolve (symbol (str main-ns) "-main")))))) 321 | 322 | (defn uberjar 323 | "Compiles the app into an Uberjar. 324 | 325 | Options: 326 | 327 | --no-clean 328 | Don't call the `clean` task before building the Uberjar." 329 | [& args] 330 | (let [{:biff.tasks/keys [main-ns generate-assets-fn] :as ctx} @config 331 | class-dir "target/jar/classes" 332 | basis (clj-build/create-basis {:project "deps.edn"}) 333 | uber-file "target/jar/app.jar" 334 | no-clean (some #{"--no-clean"} args)] 335 | (when-not no-clean 336 | (println "Cleaning...") 337 | (run-task "clean")) 338 | (println "Generating CSS...") 339 | (run-task "css" "--minify") 340 | (println "Calling" generate-assets-fn "...") 341 | ((requiring-resolve generate-assets-fn) ctx) 342 | (println "Compiling...") 343 | (clj-build/compile-clj {:basis basis 344 | :ns-compile [main-ns] 345 | :class-dir class-dir}) 346 | (println "Building uberjar...") 347 | (clj-build/copy-dir {:src-dirs ["resources" "target/resources"] 348 | :target-dir class-dir}) 349 | (clj-build/uber {:class-dir class-dir 350 | :uber-file uber-file 351 | :basis basis 352 | :main main-ns}) 353 | (println "Done. Uberjar written to" uber-file) 354 | (println (str "Test with `BIFF_PROFILE=dev java -jar " uber-file "`")))) 355 | 356 | (defn generate-secrets 357 | "Prints new secrets to put in config.env." 358 | [] 359 | (println "Put these in your config.env file:") 360 | (println) 361 | (println (str "COOKIE_SECRET=" (new-secret 16))) 362 | (println (str "JWT_SECRET=" (new-secret 32))) 363 | (println)) 364 | 365 | (defn generate-config 366 | "Creates a new config.env file if one doesn't already exist." 367 | [] 368 | (if (fs/exists? "config.env") 369 | (binding [*out* *err*] 370 | (println "config.env already exists. If you want to generate a new file, run `mv config.env config.env.backup` first.") 371 | (System/exit 3)) 372 | (let [contents (slurp (io/resource "config.template.env")) 373 | contents (str/replace contents 374 | #"\{\{\s+new-secret\s+(\d+)\s+\}\}" 375 | (fn [[_ n]] 376 | (new-secret (parse-long n))))] 377 | (spit "config.env" contents) 378 | (println "New config generated and written to config.env.")))) 379 | 380 | (defn restart 381 | "Restarts the app process via `systemctl restart app` (on the server)." 382 | [] 383 | (ssh-run @config "sudo systemctl reset-failed app.service; sudo systemctl restart app")) 384 | 385 | (defn soft-deploy 386 | "Pushes code to the server and evaluates changed files. 387 | 388 | 1. Builds css 389 | 2. Uploads files 390 | 3. `eval`s any changed files 391 | 4. Regenerates static html files 392 | 393 | Does not refresh or restart, so there isn't any downtime." 394 | [] 395 | (let [{:biff.tasks/keys [soft-deploy-fn on-soft-deploy] 396 | :keys [biff.nrepl/port] 397 | :as ctx} @config] 398 | (with-ssh-agent ctx 399 | (run-task "css" "--minify") 400 | (push-files ctx) 401 | (ssh-run ctx "trench" 402 | "-p" port 403 | "-e" (or on-soft-deploy 404 | ;; backwards compatibility 405 | (str "\"(" soft-deploy-fn " @com.biffweb/system)\"")))))) 406 | 407 | (defn deploy 408 | "Pushes code to the server and restarts the app. 409 | 410 | Uploads config and code to the server, using `rsync` if it's available, and 411 | `git push` otherwise. Then restarts the app. 412 | 413 | You must set up a server first. See https://biffweb.com/docs/reference/production/" 414 | [] 415 | (with-ssh-agent @config 416 | (run-task "css" "--minify") 417 | (push-files @config) 418 | (run-task "restart"))) 419 | 420 | (defn logs 421 | "Tails the server's application logs." 422 | ([] 423 | (logs "300")) 424 | ([n-lines] 425 | (ssh-run @config "journalctl" "-u" "app" "-f" "-n" n-lines))) 426 | 427 | (defn prod-repl 428 | "Opens an SSH tunnel so you can connect to the server via nREPL." 429 | [] 430 | (let [{:keys [biff.tasks/server biff.nrepl/port]} @config] 431 | (println "Connect to nrepl port" port) 432 | (spit ".nrepl-port" port) 433 | (shell "ssh" "-NL" (str port ":localhost:" port) (str "app@" server)))) 434 | 435 | (defn prod-dev 436 | "Runs the soft-deploy task whenever a file is modified. Also runs prod-repl and logs." 437 | [] 438 | (when-not (fs/which "rsync") 439 | (binding [*out* *err*] 440 | (println "`rsync` command not found. Please install it.") 441 | (println "Alternatively, you can deploy without downtime by running `git add .; git commit; bb soft-deploy`")) 442 | (System/exit 1)) 443 | (with-ssh-agent @config 444 | (auto-soft-deploy @config) 445 | (future (run-task "prod-repl")) 446 | (run-task "logs"))) 447 | 448 | (defn nrepl 449 | "Starts an nrepl server without starting up the application." 450 | [] 451 | (let [{:biff.nrepl/keys [port args]} @config] 452 | (spit ".nrepl-port" port) 453 | (apply nrepl-cmd/-main args))) 454 | 455 | (def tasks 456 | {"clean" #'clean 457 | "css" #'css 458 | "deploy" #'deploy 459 | "dev" #'dev 460 | "nrepl" #'nrepl 461 | "generate-secrets" #'generate-secrets 462 | "generate-config" #'generate-config 463 | "logs" #'logs 464 | "prod-dev" #'prod-dev 465 | "prod-repl" #'prod-repl 466 | "restart" #'restart 467 | "soft-deploy" #'soft-deploy 468 | "uberjar" #'uberjar 469 | "install-tailwind" #'install-tailwind}) 470 | -------------------------------------------------------------------------------- /libs/tasks/src/com/biffweb/tasks/lazy/babashka/fs.clj: -------------------------------------------------------------------------------- 1 | (ns com.biffweb.tasks.lazy.babashka.fs 2 | (:require [com.biffweb.task-runner.lazy :as lazy])) 3 | 4 | (lazy/refer-many babashka.fs [exists? which set-posix-file-permissions delete-tree parent]) 5 | -------------------------------------------------------------------------------- /libs/tasks/src/com/biffweb/tasks/lazy/babashka/process.clj: -------------------------------------------------------------------------------- 1 | (ns com.biffweb.tasks.lazy.babashka.process 2 | (:require [com.biffweb.task-runner.lazy :as lazy])) 3 | 4 | (lazy/refer-many babashka.process [shell process]) 5 | -------------------------------------------------------------------------------- /libs/tasks/src/com/biffweb/tasks/lazy/clojure/java/io.clj: -------------------------------------------------------------------------------- 1 | (ns com.biffweb.tasks.lazy.clojure.java.io 2 | (:require [com.biffweb.task-runner.lazy :as lazy])) 3 | 4 | (lazy/refer-many clojure.java.io [copy file make-parents reader resource]) 5 | -------------------------------------------------------------------------------- /libs/tasks/src/com/biffweb/tasks/lazy/clojure/java/shell.clj: -------------------------------------------------------------------------------- 1 | (ns com.biffweb.tasks.lazy.clojure.java.shell 2 | (:refer-clojure :exclude [replace]) 3 | (:require [com.biffweb.task-runner.lazy :as lazy])) 4 | 5 | (lazy/refer-many clojure.java.shell [sh]) 6 | -------------------------------------------------------------------------------- /libs/tasks/src/com/biffweb/tasks/lazy/clojure/stacktrace.clj: -------------------------------------------------------------------------------- 1 | (ns com.biffweb.tasks.lazy.clojure.stacktrace 2 | (:require [com.biffweb.task-runner.lazy :as lazy])) 3 | 4 | (lazy/refer-many clojure.stacktrace [print-stack-trace]) 5 | -------------------------------------------------------------------------------- /libs/tasks/src/com/biffweb/tasks/lazy/clojure/string.clj: -------------------------------------------------------------------------------- 1 | (ns com.biffweb.tasks.lazy.clojure.string 2 | (:refer-clojure :exclude [replace]) 3 | (:require [com.biffweb.task-runner.lazy :as lazy])) 4 | 5 | (lazy/refer-many clojure.string [includes? join lower-case split split-lines trim replace]) 6 | -------------------------------------------------------------------------------- /libs/tasks/src/com/biffweb/tasks/lazy/clojure/tools/build/api.clj: -------------------------------------------------------------------------------- 1 | (ns com.biffweb.tasks.lazy.clojure.tools.build.api 2 | (:require [com.biffweb.task-runner.lazy :as lazy])) 3 | 4 | (lazy/refer-many clojure.tools.build.api [delete copy-dir compile-clj uber create-basis]) 5 | -------------------------------------------------------------------------------- /libs/tasks/src/com/biffweb/tasks/lazy/com/biffweb/config.clj: -------------------------------------------------------------------------------- 1 | (ns com.biffweb.tasks.lazy.com.biffweb.config 2 | (:require [com.biffweb.task-runner.lazy :as lazy])) 3 | 4 | (lazy/refer-many com.biffweb.config [use-aero-config]) 5 | -------------------------------------------------------------------------------- /libs/tasks/src/com/biffweb/tasks/lazy/hato/client.clj: -------------------------------------------------------------------------------- 1 | (ns com.biffweb.tasks.lazy.hato.client 2 | (:refer-clojure :exclude [get]) 3 | (:require [com.biffweb.task-runner.lazy :as lazy])) 4 | 5 | (lazy/refer-many hato.client [get]) 6 | -------------------------------------------------------------------------------- /libs/tasks/src/com/biffweb/tasks/lazy/nextjournal/beholder.clj: -------------------------------------------------------------------------------- 1 | (ns com.biffweb.tasks.lazy.nextjournal.beholder 2 | (:refer-clojure :exclude [get]) 3 | (:require [com.biffweb.task-runner.lazy :as lazy])) 4 | 5 | (lazy/refer-many nextjournal.beholder [watch]) 6 | -------------------------------------------------------------------------------- /libs/tasks/src/com/biffweb/tasks/lazy/nrepl/cmdline.clj: -------------------------------------------------------------------------------- 1 | (ns com.biffweb.tasks.lazy.nrepl.cmdline 2 | (:require [com.biffweb.task-runner.lazy :as lazy])) 3 | 4 | (lazy/refer-many nrepl.cmdline [-main]) 5 | -------------------------------------------------------------------------------- /libs/xtdb-mock/deps.edn: -------------------------------------------------------------------------------- 1 | {} 2 | -------------------------------------------------------------------------------- /libs/xtdb-mock/src/xtdb/api.clj: -------------------------------------------------------------------------------- 1 | (ns xtdb.api 2 | (:refer-clojure :exclude [sync])) 3 | 4 | (def ^:private functions 5 | '[await-tx 6 | db 7 | entity 8 | latest-completed-tx 9 | listen 10 | open-q 11 | open-tx-log 12 | q 13 | start-node 14 | submit-tx 15 | sync 16 | tx-committed? 17 | with-tx]) 18 | 19 | (defn- fail [& args] 20 | (throw (ex-info (str "Unsupported operation. You're trying to call an XTDB function, but com.biffweb/xtdb-mock " 21 | "is in your dependencies.") 22 | {}))) 23 | 24 | (doseq [sym functions] 25 | (intern 'xtdb.api sym fail)) 26 | -------------------------------------------------------------------------------- /new-project.clj: -------------------------------------------------------------------------------- 1 | (ns com.biffweb.new-project 2 | (:require [clojure.java.shell :as shell] 3 | [clojure.java.io :as io] 4 | [clojure.string :as str])) 5 | 6 | (def repo-url "https://github.com/jacobobryant/biff") 7 | 8 | (defn sh 9 | [& args] 10 | (let [result (apply shell/sh args)] 11 | (if (= 0 (:exit result)) 12 | (:out result) 13 | (throw (ex-info (:err result) result))))) 14 | 15 | (defn prompt [msg] 16 | (print msg) 17 | (flush) 18 | (or (not-empty (read-line)) 19 | (recur msg))) 20 | 21 | (defn ns->path [s] 22 | (-> s 23 | (str/replace "-" "_") 24 | (str/replace "." "/"))) 25 | 26 | (defn rmrf [file] 27 | (when (.isDirectory file) 28 | (run! rmrf (.listFiles file))) 29 | (io/delete-file file)) 30 | 31 | (defn fetch-refs [] 32 | (-> (sh "git" "ls-remote" (str repo-url ".git")) 33 | (str/split #"\s+") 34 | (->> (partition 2) 35 | (map (comp vec reverse)) 36 | (into {})))) 37 | 38 | (defn die [& message] 39 | (binding [*out* *err*] 40 | (apply println message) 41 | (System/exit 1))) 42 | 43 | (defn shell-expand [s] 44 | (try 45 | (sh "bash" "-c" (str "echo -n " s)) 46 | (catch Exception e 47 | s))) 48 | 49 | (defn -main 50 | ([] (-main "release")) 51 | ([branch] 52 | (let [ref->commit (fetch-refs) 53 | commit (ref->commit (str "refs/heads/" branch)) 54 | _ (when-not commit 55 | (die "Invalid git branch:" branch)) 56 | tag (some-> (filter (fn [[ref_ commit_]] 57 | (and (= commit commit_) 58 | (str/starts-with? ref_ "refs/tags/v"))) 59 | ref->commit) 60 | ffirst 61 | (str/replace "refs/tags/" "")) 62 | coordinates (if tag 63 | {:git/url repo-url 64 | :git/sha (subs commit 0 7) 65 | :git/tag tag} 66 | {:git/url repo-url 67 | :git/sha commit}) 68 | dir (->> (prompt "Enter name for project directory: ") 69 | shell-expand 70 | (io/file)) 71 | main-ns (prompt "Enter main namespace (e.g. com.example): ") 72 | tmp (io/file dir "tmp") 73 | starter (io/file tmp "biff" "starter")] 74 | (io/make-parents (io/file tmp "_")) 75 | (sh "git" "clone" "--single-branch" "--branch" branch repo-url :dir tmp) 76 | (doseq [src (->> (file-seq starter) 77 | (filter #(.isFile %))) 78 | :let [relative (-> (.getPath src) 79 | (str/replace #"\\" "/") 80 | (str/replace-first #".*?biff/starter/" "") 81 | (str/replace "com/example" (ns->path main-ns))) 82 | dest (io/file dir relative)]] 83 | (io/make-parents dest) 84 | (spit dest 85 | (-> src 86 | slurp 87 | (str/replace "com.example" main-ns) 88 | (str/replace "{:local/root \"..\"}" (pr-str coordinates)) 89 | (str/replace "{:local/root \"../libs/tasks\"}" 90 | (pr-str (assoc coordinates :deps/root "libs/tasks")))))) 91 | (rmrf tmp) 92 | (io/make-parents dir "target/resources/_") 93 | (println) 94 | (println "Your project is ready. Run the following commands to get started:") 95 | (println) 96 | (println " cd" (.getPath dir)) 97 | (println " git init") 98 | (println " git add .") 99 | (println " git commit -m \"First commit\"") 100 | (println " clj -M:dev dev") 101 | (println) 102 | (println "Run `clj -M:dev --help` for a list of available commands.") 103 | (println "(Consider adding `alias biff='clj -M:dev'` to your .bashrc)") 104 | (println) 105 | (System/exit 0)))) 106 | 107 | ;; Workaround since *command-line-args* now includes options passed to bb. The docs now tell people 108 | ;; to run this script with clj instead of bb, but it does still work with bb. 109 | (apply -main (cond->> *command-line-args* 110 | (= "-e" (first *command-line-args*)) (drop 2))) 111 | -------------------------------------------------------------------------------- /src/com/biffweb/impl/auth.clj: -------------------------------------------------------------------------------- 1 | (ns com.biffweb.impl.auth 2 | (:require [com.biffweb.impl.misc :as bmisc] 3 | [com.biffweb.impl.rum :as brum] 4 | [com.biffweb.impl.time :as btime] 5 | [com.biffweb.impl.util :as butil] 6 | [com.biffweb.impl.xtdb :as bxt] 7 | ;;; NOTE: if you copy this file into your own project, remove the 8 | ;;; above lines and replace them with the com.biffweb namespace: 9 | ;[com.biffweb :as biff] 10 | [clj-http.client :as http] 11 | [clojure.string :as str] 12 | [rum.core :as rum] 13 | [xtdb.api :as xt])) 14 | 15 | (defn passed-recaptcha? [{:keys [biff/secret biff.recaptcha/threshold params] 16 | :or {threshold 0.5}}] 17 | (or (nil? (secret :recaptcha/secret-key)) 18 | (let [{:keys [success score]} 19 | (:body 20 | (http/post "https://www.google.com/recaptcha/api/siteverify" 21 | {:form-params {:secret (secret :recaptcha/secret-key) 22 | :response (:g-recaptcha-response params)} 23 | :as :json}))] 24 | (and success (or (nil? score) (<= threshold score)))))) 25 | 26 | (defn email-valid? [ctx email] 27 | (and email 28 | (re-matches #".+@.+\..+" email) 29 | (not (re-find #"\s" email)))) 30 | 31 | (defn new-link [{:keys [biff.auth/check-state 32 | biff/base-url 33 | biff/secret 34 | anti-forgery-token]} 35 | email] 36 | (str base-url "/auth/verify-link/" 37 | (bmisc/jwt-encrypt 38 | (cond-> {:intent "signin" 39 | :email email 40 | :exp-in (* 60 60)} 41 | check-state (assoc :state (butil/sha256 anti-forgery-token))) 42 | (secret :biff/jwt-secret)))) 43 | 44 | (defn new-code [length] 45 | ;; We use (SecureRandom.) instead of (SecureRandom/getInstanceStrong) because 46 | ;; the latter can block, and on some shared hosts often does. Blocking is 47 | ;; fine for e.g. generating environment variables in a new project, but we 48 | ;; don't want to block here. 49 | ;; https://tersesystems.com/blog/2015/12/17/the-right-way-to-use-securerandom/ 50 | (let [rng (java.security.SecureRandom.)] 51 | (format (str "%0" length "d") 52 | (.nextInt rng (dec (int (Math/pow 10 length))))))) 53 | 54 | (defn send-link! [{:keys [biff.auth/email-validator 55 | biff/db 56 | biff.auth/get-user-id 57 | biff/send-email 58 | params] 59 | :as ctx}] 60 | (let [email (butil/normalize-email (:email params)) 61 | url (new-link ctx email) 62 | user-id (delay (get-user-id db email))] 63 | (cond 64 | (not (passed-recaptcha? ctx)) 65 | {:success false :error "recaptcha"} 66 | 67 | (not (email-validator ctx email)) 68 | {:success false :error "invalid-email"} 69 | 70 | (not (send-email ctx 71 | {:template :signin-link 72 | :to email 73 | :url url 74 | :user-exists (some? @user-id)})) 75 | {:success false :error "send-failed"} 76 | 77 | :else 78 | {:success true :email email :user-id @user-id}))) 79 | 80 | (defn verify-link [{:keys [biff.auth/check-state 81 | biff/secret 82 | path-params 83 | params 84 | anti-forgery-token]}] 85 | (let [{:keys [intent email state]} (-> (merge params path-params) 86 | :token 87 | (bmisc/jwt-decrypt (secret :biff/jwt-secret))) 88 | valid-state (= state (butil/sha256 anti-forgery-token)) 89 | valid-email (= email (:email params))] 90 | (cond 91 | (not= intent "signin") 92 | {:success false :error "invalid-link"} 93 | 94 | (or (not check-state) valid-state valid-email) 95 | {:success true :email email} 96 | 97 | (some? (:email params)) 98 | {:success false :error "invalid-email"} 99 | 100 | :else 101 | {:success false :error "invalid-state"}))) 102 | 103 | (defn send-code! [{:keys [biff.auth/email-validator 104 | biff/db 105 | biff/send-email 106 | biff.auth/get-user-id 107 | params] 108 | :as ctx}] 109 | (let [email (butil/normalize-email (:email params)) 110 | code (new-code 6) 111 | user-id (delay (get-user-id db email))] 112 | (cond 113 | (not (passed-recaptcha? ctx)) 114 | {:success false :error "recaptcha"} 115 | 116 | (not (email-validator ctx email)) 117 | {:success false :error "invalid-email"} 118 | 119 | (not (send-email ctx 120 | {:template :signin-code 121 | :to email 122 | :code code 123 | :user-exists (some? @user-id)})) 124 | {:success false :error "send-failed"} 125 | 126 | :else 127 | {:success true :email email :code code :user-id @user-id}))) 128 | 129 | ;;; HANDLERS ------------------------------------------------------------------- 130 | 131 | (defn send-link-handler [{:keys [biff.auth/single-opt-in 132 | biff.auth/new-user-tx 133 | biff/db 134 | params] 135 | :as ctx}] 136 | (let [{:keys [success error email user-id]} (send-link! ctx)] 137 | (when (and success single-opt-in (not user-id)) 138 | (bxt/submit-tx (assoc ctx :biff.xtdb/retry false) (new-user-tx ctx email))) 139 | {:status 303 140 | :headers {"location" (if success 141 | (str "/link-sent?email=" (:email params)) 142 | (str (:on-error params "/") "?error=" error))}})) 143 | 144 | (defn verify-link-handler [{:keys [biff.auth/app-path 145 | biff.auth/invalid-link-path 146 | biff.auth/new-user-tx 147 | biff.auth/get-user-id 148 | biff.xtdb/node 149 | session 150 | params 151 | path-params] 152 | :as ctx}] 153 | (let [{:keys [success error email]} (verify-link ctx) 154 | existing-user-id (when success (get-user-id (xt/db node) email)) 155 | token (:token (merge params path-params))] 156 | (when (and success (not existing-user-id)) 157 | (bxt/submit-tx ctx (new-user-tx ctx email))) 158 | {:status 303 159 | :headers {"location" (cond 160 | success 161 | app-path 162 | 163 | (= error "invalid-state") 164 | (str "/verify-link?token=" token) 165 | 166 | (= error "invalid-email") 167 | (str "/verify-link?error=incorrect-email&token=" token) 168 | 169 | :else 170 | invalid-link-path)} 171 | :session (cond-> session 172 | success (assoc :uid (or existing-user-id 173 | (get-user-id (xt/db node) email))))})) 174 | 175 | (defn send-code-handler [{:keys [biff.auth/single-opt-in 176 | biff.auth/new-user-tx 177 | biff/db 178 | params] 179 | :as ctx}] 180 | (let [{:keys [success error email code user-id]} (send-code! ctx)] 181 | (when success 182 | (bxt/submit-tx (assoc ctx :biff.xtdb/retry false) 183 | (concat [{:db/doc-type :biff.auth/code 184 | :db.op/upsert {:biff.auth.code/email email} 185 | :biff.auth.code/code code 186 | :biff.auth.code/created-at :db/now 187 | :biff.auth.code/failed-attempts 0}] 188 | (when (and single-opt-in (not user-id)) 189 | (new-user-tx ctx email))))) 190 | {:status 303 191 | :headers {"location" (if success 192 | (str "/verify-code?email=" (:email params)) 193 | (str (:on-error params "/") "?error=" error))}})) 194 | 195 | (defn verify-code-handler [{:keys [biff.auth/app-path 196 | biff.auth/new-user-tx 197 | biff.auth/get-user-id 198 | biff.xtdb/node 199 | biff/db 200 | params 201 | session] 202 | :as ctx}] 203 | (let [email (butil/normalize-email (:email params)) 204 | code (bxt/lookup db :biff.auth.code/email email) 205 | success (and (passed-recaptcha? ctx) 206 | (some? code) 207 | (< (:biff.auth.code/failed-attempts code) 3) 208 | (not (btime/elapsed? (:biff.auth.code/created-at code) :now 3 :minutes)) 209 | (= (:code params) (:biff.auth.code/code code))) 210 | existing-user-id (when success (get-user-id db email)) 211 | tx (cond 212 | success 213 | (concat [[::xt/delete (:xt/id code)]] 214 | (when-not existing-user-id 215 | (new-user-tx ctx email))) 216 | 217 | (and (not success) 218 | (some? code) 219 | (< (:biff.auth.code/failed-attempts code) 3)) 220 | [{:db/doc-type :biff.auth/code 221 | :db/op :update 222 | :xt/id (:xt/id code) 223 | :biff.auth.code/failed-attempts [:db/add 1]}])] 224 | (bxt/submit-tx ctx tx) 225 | (if success 226 | {:status 303 227 | :headers {"location" app-path} 228 | :session (assoc session :uid (or existing-user-id 229 | (get-user-id (xt/db node) email)))} 230 | {:status 303 231 | :headers {"location" (str "/verify-code?error=invalid-code&email=" email)}}))) 232 | 233 | (defn signout [{:keys [session]}] 234 | {:status 303 235 | :headers {"location" "/"} 236 | :session (dissoc session :uid)}) 237 | 238 | ;;; ---------------------------------------------------------------------------- 239 | 240 | (defn new-user-tx [ctx email] 241 | [{:db/doc-type :user 242 | :db.op/upsert {:user/email email} 243 | :user/joined-at :db/now}]) 244 | 245 | (defn get-user-id [db email] 246 | (bxt/lookup-id db :user/email email)) 247 | 248 | (def default-options 249 | #:biff.auth{:app-path "/app" 250 | :invalid-link-path "/signin?error=invalid-link" 251 | :check-state true 252 | :new-user-tx new-user-tx 253 | :get-user-id get-user-id 254 | :single-opt-in false 255 | :email-validator email-valid?}) 256 | 257 | (defn wrap-options [handler options] 258 | (fn [ctx] 259 | (handler (merge options ctx)))) 260 | 261 | (defn module [options] 262 | {:schema {:biff.auth.code/id :uuid 263 | :biff.auth/code [:map {:closed true} 264 | [:xt/id :biff.auth.code/id] 265 | [:biff.auth.code/email :string] 266 | [:biff.auth.code/code :string] 267 | [:biff.auth.code/created-at inst?] 268 | [:biff.auth.code/failed-attempts integer?]]} 269 | :routes [["/auth" {:middleware [[wrap-options (merge default-options options)]]} 270 | ["/send-link" {:post send-link-handler}] 271 | ["/verify-link/:token" {:get verify-link-handler}] 272 | ["/verify-link" {:post verify-link-handler}] 273 | ["/send-code" {:post send-code-handler}] 274 | ["/verify-code" {:post verify-code-handler}] 275 | ["/signout" {:post signout}]]]}) 276 | 277 | 278 | ;; No one should be depending on this var since this namespace isn't part of the 279 | ;; public API, but it doesn't hurt to add an alias anyway... 280 | (def plugin module) 281 | 282 | ;;; FRONTEND HELPERS ----------------------------------------------------------- 283 | 284 | (def recaptcha-disclosure 285 | [:div {:style {:font-size "0.75rem" 286 | :line-height "1rem" 287 | :color "#4b5563"}} 288 | "This site is protected by reCAPTCHA and the Google " 289 | [:a {:href "https://policies.google.com/privacy" 290 | :target "_blank" 291 | :style {:text-decoration "underline"}} 292 | "Privacy Policy"] " and " 293 | [:a {:href "https://policies.google.com/terms" 294 | :target "_blank" 295 | :style {:text-decoration "underline"}} 296 | "Terms of Service"] " apply."]) 297 | 298 | (defn recaptcha-callback [fn-name form-id] 299 | [:script 300 | (brum/unsafe 301 | (str "function " fn-name "(token) { " 302 | "document.getElementById('" form-id "').submit();" 303 | "}"))]) 304 | -------------------------------------------------------------------------------- /src/com/biffweb/impl/htmx_refresh.clj: -------------------------------------------------------------------------------- 1 | (ns com.biffweb.impl.htmx-refresh 2 | (:require [com.biffweb.impl.rum :as brum] 3 | [clojure.string :as str] 4 | [ring.adapter.jetty9 :as jetty] 5 | [ring.util.response :as ru-response] 6 | [rum.core :as rum])) 7 | 8 | (defn send-message! [{:keys [biff.refresh/clients]} content] 9 | (let [html (rum/render-static-markup 10 | [:div#biff-refresh {:hx-swap-oob "innerHTML"} 11 | content])] 12 | (doseq [ws @clients] 13 | (jetty/send! ws html)))) 14 | 15 | (defn ws-handler [{:keys [biff.refresh/clients] :as ctx}] 16 | {:status 101 17 | :headers {"upgrade" "websocket" 18 | "connection" "upgrade"} 19 | :ws {:on-connect (fn [ws] 20 | (swap! clients conj ws)) 21 | :on-close (fn [ws status-code reason] 22 | (swap! clients disj ws))}}) 23 | 24 | (def snippet 25 | (str (rum/render-static-markup 26 | [:div#biff-refresh {:hx-ext "ws" 27 | :ws-connect "/__biff/refresh"}]) 28 | "")) 29 | 30 | (defn insert-refresh-snippet [{:keys [body] :as response}] 31 | (if-let [body-str (and (str/includes? (or (ru-response/get-header response "content-type") "") "text/html") 32 | (cond 33 | (string? body) body 34 | (#{java.io.InputStream java.io.File} (type body)) (slurp body)))] 35 | (-> response 36 | (assoc :body (str/replace body-str "" snippet)) 37 | (update :headers dissoc (some-> (ru-response/find-header response "content-length") key))) 38 | response)) 39 | 40 | (defn wrap-htmx-refresh [handler] 41 | (fn [{:keys [uri] :as ctx}] 42 | (if (= uri "/__biff/refresh") 43 | (ws-handler ctx) 44 | (insert-refresh-snippet (handler ctx))))) 45 | 46 | (defn send-refresh-command [ctx {:clojure.tools.namespace.reload/keys [error error-ns]}] 47 | (send-message! ctx (if (some? error) 48 | [:script (assoc (brum/unsafe "alert(document.querySelector('[data-biff-refresh-message]').getAttribute('data-biff-refresh-message'))") 49 | :data-biff-refresh-message 50 | (str "Compilation error in namespace " error-ns ": " 51 | (.getMessage (.getCause error))))] 52 | [:script (brum/unsafe "location.reload()")]))) 53 | 54 | (defn use-htmx-refresh [{:keys [biff/handler biff.refresh/enabled] :as ctx}] 55 | (if-not enabled 56 | ctx 57 | (-> ctx 58 | (assoc :biff.refresh/clients (atom #{})) 59 | (update :biff/handler wrap-htmx-refresh) 60 | (update :biff.eval/on-eval conj #'send-refresh-command)))) 61 | -------------------------------------------------------------------------------- /src/com/biffweb/impl/middleware.clj: -------------------------------------------------------------------------------- 1 | (ns com.biffweb.impl.middleware 2 | (:require [clojure.string :as str] 3 | [clojure.tools.logging :as log] 4 | [com.biffweb.impl.util :as util] 5 | [com.biffweb.impl.xtdb :as bxt] 6 | [muuntaja.middleware :as muuntaja] 7 | [ring.middleware.anti-forgery :as anti-forgery] 8 | [ring.middleware.content-type :refer [wrap-content-type]] 9 | [ring.middleware.defaults :as rd] 10 | [ring.middleware.resource :as res] 11 | [ring.middleware.session :as session] 12 | [ring.middleware.session.cookie :as cookie] 13 | [ring.middleware.ssl :as ssl] 14 | [rum.core :as rum])) 15 | 16 | (defn wrap-debug [handler] 17 | (fn [ctx] 18 | (util/pprint [:request ctx]) 19 | (let [resp (handler ctx)] 20 | (util/pprint [:response resp]) 21 | resp))) 22 | 23 | (defn wrap-anti-forgery-websockets [handler] 24 | (fn [{:keys [biff/base-url headers] :as ctx}] 25 | (if (and (str/includes? (str/lower-case (get headers "upgrade" "")) "websocket") 26 | (str/includes? (str/lower-case (get headers "connection" "")) "upgrade") 27 | (some? base-url) 28 | (not= base-url (get headers "origin"))) 29 | {:status 403 30 | :headers {"content-type" "text/plain"} 31 | :body "Forbidden"} 32 | (handler ctx)))) 33 | 34 | (defn wrap-render-rum [handler] 35 | (fn [ctx] 36 | (let [response (handler ctx)] 37 | (if (vector? response) 38 | {:status 200 39 | :headers {"content-type" "text/html"} 40 | :body (str "\n" (rum/render-static-markup response))} 41 | response)))) 42 | 43 | ;; Deprecated; wrap-resource does this inline now. 44 | (defn wrap-index-files [handler {:keys [index-files] 45 | :or {index-files ["index.html"]}}] 46 | (fn [ctx] 47 | (->> index-files 48 | (map #(update ctx :uri str/replace-first #"/?$" (str "/" %))) 49 | (into [ctx]) 50 | (some (wrap-content-type handler))))) 51 | 52 | (defn wrap-resource 53 | ([handler] 54 | (fn [{:biff.middleware/keys [root index-files] 55 | :or {root "public" 56 | index-files ["index.html"]} 57 | :as ctx}] 58 | (or (->> index-files 59 | (map #(update ctx :uri str/replace-first #"/?$" (str "/" %))) 60 | (into [ctx]) 61 | (some (wrap-content-type #(res/resource-request % root)))) 62 | (handler ctx)))) 63 | ;; Deprecated, use 1-arg arity 64 | ([handler {:biff.middleware/keys [root index-files] 65 | :or {root "public" 66 | index-files ["index.html"]}}] 67 | (let [resource-handler (wrap-index-files 68 | #(res/resource-request % root) 69 | {:index-files index-files})] 70 | (fn [ctx] 71 | (or (resource-handler ctx) 72 | (handler ctx)))))) 73 | 74 | (defn wrap-internal-error 75 | ([handler] 76 | (fn [{:biff.middleware/keys [on-error] 77 | :or {on-error util/default-on-error} 78 | :as ctx}] 79 | (try 80 | (handler ctx) 81 | (catch Throwable t 82 | (log/error t "Exception while handling request") 83 | (on-error (assoc ctx :status 500 :ex t)))))) 84 | ;; Deprecated, use 1-arg arity 85 | ([handler {:biff.middleware/keys [on-error] 86 | :or {on-error util/default-on-error}}] 87 | (fn [ctx] 88 | (try 89 | (handler ctx) 90 | (catch Throwable t 91 | (log/error t "Exception while handling request") 92 | (on-error (assoc ctx :status 500 :ex t))))))) 93 | 94 | (defn wrap-log-requests [handler] 95 | (fn [ctx] 96 | (let [start (System/nanoTime) 97 | resp (handler ctx) 98 | stop (System/nanoTime) 99 | duration (quot (- stop start) 1000000)] 100 | (log/infof "%3sms %s %-4s %s" 101 | (str duration) 102 | (:status resp "nil") 103 | (name (:request-method ctx)) 104 | (str (:uri ctx) 105 | (when-some [qs (:query-string ctx)] 106 | (str "?" qs)))) 107 | resp))) 108 | 109 | (defn wrap-https-scheme [handler] 110 | (fn [{:keys [biff.middleware/secure] :or {secure true} :as ctx}] 111 | (handler (if (and secure (= :http (:scheme ctx))) 112 | (assoc ctx :scheme :https) 113 | ctx)))) 114 | 115 | (defn wrap-session [handler] 116 | (fn [{:keys [biff/secret] 117 | :biff.middleware/keys [session-store 118 | cookie-secret 119 | secure 120 | session-max-age 121 | session-same-site] 122 | :or {session-max-age (* 60 60 24 60) 123 | secure true 124 | session-same-site :lax} 125 | :as ctx}] 126 | (let [cookie-secret (if secret 127 | (secret :biff.middleware/cookie-secret) 128 | ;; For backwards compatibility 129 | cookie-secret) 130 | session-store (if cookie-secret 131 | (cookie/cookie-store 132 | {:key (util/base64-decode cookie-secret)}) 133 | session-store) 134 | handler (session/wrap-session 135 | handler 136 | {:cookie-attrs {:max-age session-max-age 137 | :same-site session-same-site 138 | :http-only true 139 | :secure secure} 140 | :store session-store})] 141 | (handler ctx)))) 142 | 143 | (defn wrap-ssl [handler] 144 | (fn [{:keys [biff.middleware/secure 145 | biff.middleware/hsts 146 | biff.middleware/ssl-redirect] 147 | :or {secure true 148 | hsts true 149 | ssl-redirect false} 150 | :as ctx}] 151 | (let [handler (if secure 152 | (cond-> handler 153 | hsts ssl/wrap-hsts 154 | ssl-redirect ssl/wrap-ssl-redirect) 155 | handler)] 156 | (handler ctx)))) 157 | 158 | (defn wrap-site-defaults [handler] 159 | (-> handler 160 | wrap-render-rum 161 | wrap-anti-forgery-websockets 162 | anti-forgery/wrap-anti-forgery 163 | wrap-session 164 | muuntaja/wrap-params 165 | muuntaja/wrap-format 166 | (rd/wrap-defaults (-> rd/site-defaults 167 | (assoc-in [:security :anti-forgery] false) 168 | (assoc-in [:responses :absolute-redirects] true) 169 | (assoc :session false) 170 | (assoc :static false))))) 171 | 172 | (defn wrap-api-defaults [handler] 173 | (-> handler 174 | muuntaja/wrap-params 175 | muuntaja/wrap-format 176 | (rd/wrap-defaults rd/api-defaults))) 177 | 178 | (defn wrap-base-defaults [handler] 179 | (-> handler 180 | wrap-https-scheme 181 | wrap-resource 182 | wrap-internal-error 183 | wrap-ssl 184 | wrap-log-requests)) 185 | 186 | (defn use-wrap-ctx [{:keys [biff/handler] :as ctx}] 187 | (assoc ctx :biff/handler (fn [req] 188 | (handler (merge (bxt/merge-context ctx) req))))) 189 | 190 | ;;; Deprecated 191 | 192 | (defn wrap-ring-defaults 193 | "Deprecated" 194 | [handler {:keys [biff/secret] 195 | :biff.middleware/keys [session-store 196 | cookie-secret 197 | secure 198 | session-max-age] 199 | :or {session-max-age (* 60 60 24 60) 200 | secure true} 201 | :as ctx}] 202 | (let [cookie-secret (if secret 203 | (secret :biff.middleware/cookie-secret) 204 | ;; For backwards compatibility 205 | cookie-secret) 206 | session-store (if cookie-secret 207 | (cookie/cookie-store 208 | {:key (util/base64-decode cookie-secret)}) 209 | session-store) 210 | changes {[:responses :absolute-redirects] true 211 | [:session :store] session-store 212 | [:session :cookie-name] "ring-session" 213 | [:session :cookie-attrs :max-age] session-max-age 214 | [:session :cookie-attrs :same-site] :lax 215 | [:security :anti-forgery] false 216 | [:security :ssl-redirect] false 217 | [:static] false} 218 | ring-defaults (reduce (fn [m [path value]] 219 | (assoc-in m path value)) 220 | (if secure 221 | rd/secure-site-defaults 222 | rd/site-defaults) 223 | changes)] 224 | (cond-> handler 225 | true (rd/wrap-defaults ring-defaults) 226 | ;; This is necessary when using a reverse proxy (e.g. Nginx), otherwise 227 | ;; wrap-absolute-redirects will set the redirect scheme to http. 228 | secure wrap-https-scheme))) 229 | 230 | (defn wrap-env 231 | "Deprecated" 232 | [handler ctx] 233 | (fn [req] 234 | (handler (merge (bxt/merge-context ctx) req)))) 235 | 236 | (defn wrap-inner-defaults 237 | "Deprecated" 238 | [handler opts] 239 | (-> handler 240 | muuntaja/wrap-params 241 | muuntaja/wrap-format 242 | (wrap-resource opts) 243 | (wrap-internal-error opts) 244 | wrap-log-requests)) 245 | 246 | (defn wrap-outer-defaults 247 | "Deprecated" 248 | [handler opts] 249 | (-> handler 250 | (wrap-ring-defaults opts) 251 | (wrap-env opts))) 252 | -------------------------------------------------------------------------------- /src/com/biffweb/impl/misc.clj: -------------------------------------------------------------------------------- 1 | (ns com.biffweb.impl.misc 2 | (:require [buddy.core.nonce :as nonce] 3 | [buddy.sign.jwt :as jwt] 4 | [chime.core :as chime] 5 | [clj-http.client :as http] 6 | [clojure.string :as str] 7 | [clojure.tools.logging :as log] 8 | [com.biffweb.impl.time :as time] 9 | [com.biffweb.impl.util :as util] 10 | [com.biffweb.impl.xtdb :as bxt] 11 | [hawk.core :as hawk] 12 | [nextjournal.beholder :as beholder] 13 | [reitit.ring :as reitit-ring] 14 | [ring.adapter.jetty9 :as jetty])) 15 | 16 | (defn use-beholder [{:biff.beholder/keys [on-save exts paths enabled] 17 | :or {paths ["src" "resources" "test"] 18 | enabled true} 19 | :as ctx}] 20 | (if-not enabled 21 | ctx 22 | (let [;; Poor man's debouncer -- don't want to pull in core.async just for 23 | ;; this, and don't want to spend time figuring out how else to do it. 24 | last-called (atom (java.util.Date.)) 25 | watch (apply beholder/watch 26 | (fn [{:keys [path]}] 27 | (when (and (or (empty? exts) 28 | (some #(str/ends-with? path %) exts)) 29 | (time/elapsed? @last-called :now 1 :seconds)) 30 | ;; Give all the files some time to get written before invoking the callback. 31 | (Thread/sleep 100) 32 | (util/catchall-verbose (on-save ctx)) 33 | (reset! last-called (java.util.Date.)))) 34 | paths)] 35 | (update ctx :biff/stop conj #(beholder/stop watch))))) 36 | 37 | ;; Deprecated 38 | (defn use-hawk [{:biff.hawk/keys [on-save exts paths] 39 | :or {paths ["src" "resources"]} 40 | :as ctx}] 41 | (let [watch (hawk/watch! 42 | [(merge {:paths paths 43 | ;; todo debounce this properly 44 | :handler (fn [{:keys [last-ran] 45 | :or {last-ran 0}} _] 46 | (when (< 500 (- (inst-ms (java.util.Date.)) last-ran)) 47 | (on-save ctx)) 48 | {:last-ran (inst-ms (java.util.Date.))})} 49 | (when exts 50 | {:filter (fn [_ {:keys [^java.io.File file]}] 51 | (let [path (.getPath file)] 52 | (some #(str/ends-with? path %) exts)))}))])] 53 | (update ctx :biff/stop conj #(hawk/stop! watch)))) 54 | 55 | (defn reitit-handler [{:keys [router routes on-error]}] 56 | (let [make-error-handler (fn [status] 57 | (fn [ctx] 58 | ((or on-error 59 | (:biff.middleware/on-error ctx on-error) 60 | util/default-on-error) 61 | (assoc ctx :status status))))] 62 | (reitit-ring/ring-handler 63 | (or router (reitit-ring/router routes)) 64 | (reitit-ring/routes 65 | (reitit-ring/redirect-trailing-slash-handler) 66 | (reitit-ring/create-default-handler 67 | {:not-found (make-error-handler 404) 68 | :method-not-allowed (make-error-handler 405) 69 | :not-acceptable (make-error-handler 406)}))))) 70 | 71 | (defn use-jetty [{:biff/keys [host port handler] 72 | :or {host "localhost" 73 | port 8080} 74 | :as ctx}] 75 | (let [server (jetty/run-jetty (fn [req] 76 | (handler (merge (bxt/merge-context ctx) req))) 77 | {:host host 78 | :port port 79 | :join? false 80 | :allow-null-path-info true})] 81 | (log/info "Jetty running on" (str "http://" host ":" port)) 82 | (update ctx :biff/stop conj #(jetty/stop-server server)))) 83 | 84 | (defn mailersend [{:keys [mailersend/api-key 85 | mailersend/defaults]} 86 | opts] 87 | (let [opts (reduce (fn [opts [path x]] 88 | (update-in opts path #(or % x))) 89 | opts 90 | defaults)] 91 | (try 92 | (get-in 93 | (http/post "https://api.mailersend.com/v1/email" 94 | {:content-type :json 95 | :oauth-token api-key 96 | :form-params opts}) 97 | [:headers "X-Message-Id"]) 98 | (catch Exception e 99 | (log/error e "MailerSend exception") 100 | false)))) 101 | 102 | (defn jwt-encrypt 103 | [claims secret] 104 | (jwt/encrypt 105 | (-> claims 106 | (assoc :exp (time/add-seconds (time/now) (:exp-in claims))) 107 | (dissoc :exp-in)) 108 | (util/base64-decode secret) 109 | {:alg :a256kw :enc :a128gcm})) 110 | 111 | (defn jwt-decrypt 112 | [token secret] 113 | (try 114 | (jwt/decrypt 115 | token 116 | (util/base64-decode secret) 117 | {:alg :a256kw :enc :a128gcm}) 118 | (catch Exception _ 119 | nil))) 120 | 121 | (defn use-chime 122 | [{:keys [biff/features biff/plugins biff/modules biff.chime/tasks] :as ctx}] 123 | (reduce (fn [ctx {:keys [schedule task error-handler]}] 124 | (let [f (fn [_] (task (bxt/merge-context ctx))) 125 | opts (when error-handler {:error-handler error-handler}) 126 | scheduler (chime/chime-at (schedule) f opts)] 127 | (update ctx :biff/stop conj #(.close scheduler)))) 128 | ctx 129 | (or tasks 130 | (some->> (or modules plugins features) deref (mapcat :tasks))))) 131 | 132 | (defn generate-secret [length] 133 | (let [buffer (byte-array length)] 134 | (.nextBytes (java.security.SecureRandom/getInstanceStrong) buffer) 135 | (.encodeToString (java.util.Base64/getEncoder) buffer))) 136 | 137 | (defn use-random-default-secrets [ctx] 138 | (merge ctx 139 | (when (nil? (:biff.middleware/cookie-secret ctx)) 140 | (log/warn ":biff.middleware/cookie-secret is empty, using random value") 141 | {:biff.middleware/cookie-secret (generate-secret 16)}) 142 | (when (nil? (:biff/jwt-secret ctx)) 143 | (log/warn ":biff/jwt-secret is empty, using random value") 144 | {:biff/jwt-secret (generate-secret 32)}))) 145 | 146 | (defn get-secret [ctx k] 147 | (some-> (get ctx k) 148 | (System/getenv) 149 | not-empty)) 150 | 151 | (defn use-secrets [ctx] 152 | (when-not (every? #(get-secret ctx %) [:biff.middleware/cookie-secret :biff/jwt-secret]) 153 | (binding [*out* *err*] 154 | (println "Secrets are missing. Run `bb generate-secrets` and edit secrets.env.") 155 | (System/exit 1))) 156 | (assoc ctx :biff/secret #(get-secret ctx %))) 157 | 158 | (defn doc-schema [{:keys [required optional closed wildcards] 159 | :or {closed true}}] 160 | (let [ks (->> (concat required optional) 161 | (map #(cond-> % (not (keyword? %)) first))) 162 | schema (vec (concat [:map {:closed (and (not wildcards) closed)}] 163 | required 164 | (for [x optional 165 | :let [[k & rst] (if (keyword? x) 166 | [x] 167 | x) 168 | [opts rst] (if (map? (first rst)) 169 | [(first rst) (rest rst)] 170 | [{} rst]) 171 | opts (assoc opts :optional true)]] 172 | (into [k opts] rst)))) 173 | schema (if-not wildcards 174 | schema 175 | [:and 176 | schema 177 | [:fn (fn [doc] 178 | (every? (fn [[k v]] 179 | (if-let [v-pred (and (keyword? k) 180 | (wildcards (symbol (namespace k))))] 181 | (v-pred v) 182 | (not closed))) 183 | (apply dissoc doc ks)))]])] 184 | schema)) 185 | -------------------------------------------------------------------------------- /src/com/biffweb/impl/queues.clj: -------------------------------------------------------------------------------- 1 | (ns com.biffweb.impl.queues 2 | (:require [com.biffweb.impl.xtdb :as bxt] 3 | [com.biffweb.impl.util :as util]) 4 | (:import [java.util.concurrent 5 | PriorityBlockingQueue 6 | TimeUnit 7 | Executors 8 | Callable])) 9 | 10 | (defn- consume [ctx {:keys [queue consumer continue]}] 11 | (while @continue 12 | (when-some [job (.poll queue 1 TimeUnit/SECONDS)] 13 | (util/catchall-verbose 14 | (consumer (merge (bxt/merge-context ctx) 15 | {:biff/job job 16 | :biff/queue queue}))) 17 | (flush)))) 18 | 19 | (defn- stop [{:keys [biff.queues/stop-timeout] 20 | :or {stop-timeout 10000}} configs] 21 | (let [timeout (+ (System/nanoTime) (* stop-timeout (Math/pow 10 6)))] 22 | (some-> (first configs) 23 | :continue 24 | (reset! false)) 25 | (run! #(.shutdown (:executor %)) configs) 26 | (doseq [{:keys [executor]} configs 27 | :let [time-left (- timeout (System/nanoTime))] 28 | :when (< 0 time-left)] 29 | (.awaitTermination executor time-left TimeUnit/NANOSECONDS)) 30 | (run! #(.shutdownNow (:executor %)) configs))) 31 | 32 | (defn- default-queue [] 33 | (PriorityBlockingQueue. 11 (fn [a b] 34 | (compare (:biff/priority a 10) 35 | (:biff/priority b 10))))) 36 | 37 | (defn- init [{:keys [biff/features 38 | biff/plugins 39 | biff/modules 40 | biff.queues/enabled-ids]}] 41 | (let [continue (atom true)] 42 | (->> @(or modules plugins features) 43 | (mapcat :queues) 44 | (filter (fn [q] 45 | (or (nil? enabled-ids) (contains? enabled-ids (:id q))))) 46 | (map (fn [{:keys [id n-threads consumer queue-fn] 47 | :or {n-threads 1 48 | queue-fn default-queue}}] 49 | {:id id 50 | :n-threads n-threads 51 | :consumer consumer 52 | :queue (queue-fn) 53 | :executor (Executors/newFixedThreadPool n-threads) 54 | :continue continue}))))) 55 | 56 | (defn use-queues [ctx] 57 | (let [configs (init ctx) 58 | queues (into {} (map (juxt :id :queue) configs)) 59 | ctx (-> ctx 60 | (assoc :biff/queues queues) 61 | (update :biff/stop conj #(stop ctx configs)))] 62 | (doseq [{:keys [executor n-threads] :as config} configs 63 | _ (range n-threads)] 64 | (.submit executor ^Callable #(consume ctx config))) 65 | ctx)) 66 | 67 | (defn submit-job [ctx queue-id job] 68 | (.add (get-in ctx [:biff/queues queue-id]) job)) 69 | 70 | (defn submit-job-for-result [{:keys [biff.queues/result-timeout] 71 | :or {result-timeout 20000} 72 | :as ctx} 73 | queue-id 74 | job] 75 | (let [p (promise) 76 | result (if result-timeout 77 | (delay (deref p result-timeout ::timeout)) 78 | p)] 79 | (submit-job ctx queue-id (assoc job :biff/callback #(deliver p %))) 80 | (delay (cond 81 | (= @result ::timeout) 82 | (throw (ex-info "Timed out while waiting for job result" {:queue-id queue-id :job job})) 83 | 84 | (instance? Exception @result) 85 | (throw @result) 86 | 87 | :else 88 | @result)))) 89 | -------------------------------------------------------------------------------- /src/com/biffweb/impl/rum.clj: -------------------------------------------------------------------------------- 1 | (ns com.biffweb.impl.rum 2 | (:require [clojure.java.io :as io] 3 | [clojure.string :as str] 4 | [com.biffweb.impl.util :as util] 5 | [ring.middleware.anti-forgery :as anti-forgery] 6 | [rum.core :as rum])) 7 | 8 | (defn render [body] 9 | {:status 200 10 | :headers {"content-type" "text/html; charset=utf-8"} 11 | :body (str "\n" (rum/render-static-markup body))}) 12 | 13 | (defn unsafe [html] 14 | {:dangerouslySetInnerHTML {:__html html}}) 15 | 16 | (def emdash [:span (unsafe "—")]) 17 | 18 | (def endash [:span (unsafe "–")]) 19 | 20 | (def nbsp [:span (unsafe " ")]) 21 | 22 | (defn g-fonts 23 | [families] 24 | [:link {:href (apply str "https://fonts.googleapis.com/css2?display=swap" 25 | (for [f families] 26 | (str "&family=" f))) 27 | :rel "stylesheet"}]) 28 | 29 | (defn base-html 30 | [{:base/keys [title 31 | description 32 | lang 33 | image 34 | icon 35 | url 36 | canonical 37 | font-families 38 | head]} 39 | & contents] 40 | [:html 41 | {:lang lang 42 | :style {:min-height "100%" 43 | :height "auto"}} 44 | [:head 45 | [:title title] 46 | [:meta {:name "description" :content description}] 47 | [:meta {:content title :property "og:title"}] 48 | [:meta {:content description :property "og:description"}] 49 | (when image 50 | [:<> 51 | [:meta {:content image :property "og:image"}] 52 | [:meta {:content "summary_large_image" :name "twitter:card"}]]) 53 | (when-some [url (or url canonical)] 54 | [:meta {:content url :property "og:url"}]) 55 | (when-some [url (or canonical url)] 56 | [:link {:ref "canonical" :href url}]) 57 | [:meta {:name "viewport" :content "width=device-width, initial-scale=1"}] 58 | (when icon 59 | [:link {:rel "icon" 60 | :type "image/png" 61 | :sizes "16x16" 62 | :href icon}]) 63 | [:meta {:charset "utf-8"}] 64 | (when (not-empty font-families) 65 | [:<> 66 | [:link {:href "https://fonts.googleapis.com", :rel "preconnect"}] 67 | [:link {:crossorigin "crossorigin", 68 | :href "https://fonts.gstatic.com", 69 | :rel "preconnect"}] 70 | (g-fonts font-families)]) 71 | (into [:<>] head)] 72 | [:body 73 | {:style {:position "absolute" 74 | :width "100%" 75 | :min-height "100%" 76 | :display "flex" 77 | :flex-direction "column"}} 78 | contents]]) 79 | 80 | (defn form 81 | [{:keys [hidden] :as opts} & body] 82 | [:form (-> (merge {:method "post"} opts) 83 | (dissoc :hidden) 84 | (assoc-in [:style :margin-bottom] 0)) 85 | (for [[k v] (util/assoc-some hidden "__anti-forgery-token" anti-forgery/*anti-forgery-token*)] 86 | [:input {:type "hidden" 87 | :name k 88 | :value v}]) 89 | body]) 90 | 91 | ;; you could say that rum is one of our main exports 92 | (defn export-rum 93 | [pages dir] 94 | (doseq [[path rum] pages 95 | :let [full-path (cond-> (str dir path) 96 | (str/ends-with? path "/") (str "index.html"))]] 97 | (io/make-parents full-path) 98 | (spit full-path (str "\n" (rum/render-static-markup rum))))) 99 | -------------------------------------------------------------------------------- /src/com/biffweb/impl/time.clj: -------------------------------------------------------------------------------- 1 | (ns com.biffweb.impl.time) 2 | 3 | (def rfc3339 "yyyy-MM-dd'T'HH:mm:ss.SSSXXX") 4 | 5 | (defn parse-date [date & [format]] 6 | (.parse (new java.text.SimpleDateFormat (or format rfc3339)) date)) 7 | 8 | (defn format-date [date & [format]] 9 | (.format (new java.text.SimpleDateFormat (or format rfc3339)) date)) 10 | 11 | (defn crop-date [d fmt] 12 | (-> d 13 | (format-date fmt) 14 | (parse-date fmt))) 15 | 16 | (defn crop-day [t] 17 | (crop-date t "yyyy-MM-dd")) 18 | 19 | (defn- expand-now [x] 20 | (if (= x :now) 21 | (java.util.Date.) 22 | x)) 23 | 24 | (defn seconds-between [t1 t2] 25 | (quot (- (inst-ms (expand-now t2)) (inst-ms (expand-now t1))) 1000)) 26 | 27 | (defn seconds-in [x unit] 28 | (case unit 29 | :seconds x 30 | :minutes (* x 60) 31 | :hours (* x 60 60) 32 | :days (* x 60 60 24) 33 | :weeks (* x 60 60 24 7))) 34 | 35 | (defn elapsed? [t1 t2 x unit] 36 | (<= (seconds-in x unit) 37 | (seconds-between t1 t2))) 38 | 39 | (defn between-hours? [t h1 h2] 40 | (let [hours (/ (mod (quot (inst-ms t) (* 1000 60)) 41 | (* 60 24)) 42 | 60.0)] 43 | (if (< h1 h2) 44 | (<= h1 hours h2) 45 | (or (<= h1 hours) 46 | (<= hours h2))))) 47 | 48 | (defn add-seconds [date seconds] 49 | (java.util.Date/from (.plusSeconds (.toInstant date) seconds))) 50 | 51 | (defn now [] 52 | (java.util.Date.)) 53 | -------------------------------------------------------------------------------- /src/com/biffweb/impl/util.clj: -------------------------------------------------------------------------------- 1 | (ns com.biffweb.impl.util 2 | (:require [clojure.edn :as edn] 3 | [clojure.java.io :as io] 4 | [clojure.java.shell :as shell] 5 | [clojure.pprint :as pp] 6 | [clojure.spec.alpha :as spec] 7 | [clojure.stacktrace :as st] 8 | [clojure.string :as str] 9 | [clojure.tools.deps.alpha.repl :as deps-repl] 10 | [clojure.tools.logging :as log] 11 | [clojure.tools.namespace.repl :as tn-repl] 12 | [clojure.walk :as walk] 13 | [com.biffweb.impl.time :as time]) 14 | (:import [clojure.lang DynamicClassLoader])) 15 | 16 | (defmacro catchall-verbose 17 | [& body] 18 | `(try 19 | ~@body 20 | (catch Exception e# 21 | (st/print-stack-trace e#)))) 22 | 23 | (defn start-system [system-atom init] 24 | (reset! system-atom (merge {:biff/stop '()} init)) 25 | (loop [{[f & components] :biff/components :as ctx} init] 26 | (when (some? f) 27 | (log/info "starting:" (str f)) 28 | (recur (reset! system-atom (f (assoc ctx :biff/components components)))))) 29 | (log/info "System started.") 30 | @system-atom) 31 | 32 | (defn refresh [{:keys [biff/after-refresh biff/stop]}] 33 | (doseq [f stop] 34 | (log/info "stopping:" (str f)) 35 | (f)) 36 | (tn-repl/refresh :after after-refresh)) 37 | 38 | (defn add-libs [] 39 | (let [cl (.getContextClassLoader (Thread/currentThread))] 40 | (when-not (instance? DynamicClassLoader cl) 41 | (.setContextClassLoader (Thread/currentThread) (DynamicClassLoader. cl)))) 42 | (deps-repl/add-libs (:deps (edn/read-string (slurp "deps.edn"))))) 43 | 44 | (defn ppr-str [x] 45 | (with-out-str 46 | (binding [*print-namespace-maps* false] 47 | (pp/pprint x)))) 48 | 49 | (defn pprint [object & [writer]] 50 | (binding [*print-namespace-maps* false] 51 | (if writer 52 | (pp/pprint object writer) 53 | (pp/pprint object))) 54 | (flush)) 55 | 56 | (defn base64-encode [bs] 57 | (.encodeToString (java.util.Base64/getEncoder) bs)) 58 | 59 | (defn base64-decode [s] 60 | (.decode (java.util.Base64/getDecoder) s)) 61 | 62 | (defn sha256 [string] 63 | (let [digest (.digest (java.security.MessageDigest/getInstance "SHA-256") (.getBytes string "UTF-8"))] 64 | (apply str (map (partial format "%02x") digest)))) 65 | 66 | (defn assoc-some [m & kvs] 67 | (->> kvs 68 | (partition 2) 69 | (filter (comp some? second)) 70 | (map vec) 71 | (into m))) 72 | 73 | (defn safe-merge [& ms] 74 | (reduce (fn [m1 m2] 75 | (let [dupes (filter #(contains? m1 %) (keys m2))] 76 | (when (not-empty dupes) 77 | (throw (ex-info (str "Maps contain duplicate keys: " (str/join ", " dupes)) 78 | {:keys dupes}))) 79 | (merge m1 m2))) 80 | {} 81 | ms)) 82 | 83 | (defn sh [& args] 84 | (let [result (apply shell/sh args)] 85 | (if (= 0 (:exit result)) 86 | (:out result) 87 | (throw (ex-info (:err result) result))))) 88 | 89 | (defn use-when [f & components] 90 | (fn [ctx] 91 | (if (f ctx) 92 | (reduce (fn [system component] 93 | (log/info "starting:" (str component)) 94 | (component system)) 95 | ctx 96 | components) 97 | ctx))) 98 | 99 | (defn anomaly? [x] 100 | (spec/valid? (spec/keys :req [:cognitect.anomalies/category] 101 | :opt [:cognitect.anomalies/message]) 102 | x)) 103 | 104 | (defn anom [category & [message & [opts]]] 105 | (merge opts 106 | {:cognitect.anomalies/category (keyword "cognitect.anomalies" (name category))} 107 | (when message 108 | {:cognitect.anomalies/message message}))) 109 | 110 | (def http-status->msg 111 | {100 "Continue" 112 | 101 "Switching Protocols" 113 | 102 "Processing" 114 | 200 "OK" 115 | 201 "Created" 116 | 202 "Accepted" 117 | 203 "Non-Authoritative Information" 118 | 204 "No Content" 119 | 205 "Reset Content" 120 | 206 "Partial Content" 121 | 207 "Multi-Status" 122 | 208 "Already Reported" 123 | 226 "IM Used" 124 | 300 "Multiple Choices" 125 | 301 "Moved Permanently" 126 | 302 "Found" 127 | 303 "See Other" 128 | 304 "Not Modified" 129 | 305 "Use Proxy" 130 | 306 "Reserved" 131 | 307 "Temporary Redirect" 132 | 308 "Permanent Redirect" 133 | 400 "Bad Request" 134 | 401 "Unauthorized" 135 | 402 "Payment Required" 136 | 403 "Forbidden" 137 | 404 "Not Found" 138 | 405 "Method Not Allowed" 139 | 406 "Not Acceptable" 140 | 407 "Proxy Authentication Required" 141 | 408 "Request Timeout" 142 | 409 "Conflict" 143 | 410 "Gone" 144 | 411 "Length Required" 145 | 412 "Precondition Failed" 146 | 413 "Request Entity Too Large" 147 | 414 "Request-URI Too Long" 148 | 415 "Unsupported Media Type" 149 | 416 "Requested Range Not Satisfiable" 150 | 417 "Expectation Failed" 151 | 422 "Unprocessable Entity" 152 | 423 "Locked" 153 | 424 "Failed Dependency" 154 | 425 "Unassigned" 155 | 426 "Upgrade Required" 156 | 427 "Unassigned" 157 | 428 "Precondition Required" 158 | 429 "Too Many Requests" 159 | 430 "Unassigned" 160 | 431 "Request Header Fields Too Large" 161 | 500 "Internal Server Error" 162 | 501 "Not Implemented" 163 | 502 "Bad Gateway" 164 | 503 "Service Unavailable" 165 | 504 "Gateway Timeout" 166 | 505 "HTTP Version Not Supported" 167 | 506 "Variant Also Negotiates (Experimental)" 168 | 507 "Insufficient Storage" 169 | 508 "Loop Detected" 170 | 509 "Unassigned" 171 | 510 "Not Extended" 172 | 511 "Network Authentication Required"}) 173 | 174 | (defn default-on-error [{:keys [status]}] 175 | {:status status 176 | :headers {"content-type" "text/html"} 177 | :body (str "

" (http-status->msg status) "

")}) 178 | 179 | (defn- wrap-deref [form syms] 180 | (walk/postwalk (fn [sym] 181 | (if (contains? syms sym) 182 | `(deref ~sym) 183 | sym)) 184 | form)) 185 | 186 | (defn letd* [bindings & body] 187 | (let [[bindings syms] (->> bindings 188 | destructure 189 | (partition 2) 190 | (reduce (fn [[bindings syms] [sym form]] 191 | [(into bindings [sym `(delay ~(wrap-deref form syms))]) 192 | (conj syms sym)]) 193 | [[] #{}]))] 194 | `(let ~bindings 195 | ~@(wrap-deref body syms)))) 196 | 197 | (defn fix-print* [& body] 198 | `(binding [*out* (alter-var-root #'*out* identity) 199 | *err* (alter-var-root #'*err* identity) 200 | *flush-on-newline* (alter-var-root #'*flush-on-newline* identity)] 201 | ~@body)) 202 | 203 | (defn delete-old-files [{:keys [dir exts age-seconds] 204 | :or {age-seconds 30}}] 205 | (doseq [file (file-seq (io/file dir)) 206 | :when (and (.isFile file) 207 | (time/elapsed? (java.util.Date. (.lastModified file)) 208 | :now 209 | age-seconds 210 | :seconds) 211 | (or (empty? exts) 212 | (some #(str/ends-with? (.getPath file) %) exts)))] 213 | (log/info "deleting" file) 214 | (io/delete-file file))) 215 | 216 | (defn join [sep xs] 217 | (rest (mapcat vector (repeat sep) xs))) 218 | 219 | (defn normalize-email [email] 220 | (some-> email str/trim str/lower-case not-empty)) 221 | 222 | ;;;; Deprecated 223 | 224 | (defn read-config [path] 225 | (let [env (keyword (or (System/getenv "BIFF_ENV") "prod")) 226 | env->config (edn/read-string (slurp path)) 227 | config-keys (concat (get-in env->config [env :merge]) [env]) 228 | config (apply merge (map env->config config-keys))] 229 | config)) 230 | -------------------------------------------------------------------------------- /src/com/biffweb/impl/util/ns.clj: -------------------------------------------------------------------------------- 1 | (ns com.biffweb.impl.util.ns 2 | (:require [clojure.string :as str])) 3 | 4 | (defn ns-parts [nspace] 5 | (if (empty? (str nspace)) 6 | [] 7 | (str/split (str nspace) #"\."))) 8 | 9 | (defn select-ns [m nspace] 10 | (let [parts (ns-parts nspace)] 11 | (->> (keys m) 12 | (filterv (fn [k] 13 | (= parts (take (count parts) (ns-parts (namespace k)))))) 14 | (select-keys m)))) 15 | 16 | (defn select-ns-as [m ns-from ns-to] 17 | (into {} 18 | (map (fn [[k v]] 19 | (let [new-ns-parts (->> (ns-parts (namespace k)) 20 | (drop (count (ns-parts ns-from))) 21 | (concat (ns-parts ns-to)))] 22 | [(if (empty? new-ns-parts) 23 | (keyword (name k)) 24 | (keyword (str/join "." new-ns-parts) (name k))) 25 | v]))) 26 | (select-ns m ns-from))) 27 | 28 | (comment 29 | (select-ns-as {:a 1} nil 'b.c) ; #:b.c{:a 1} 30 | (select-ns-as {:a.b/c 1} 'a 'd) ; #:d.b{:c 1} 31 | (select-ns-as {:a.b/c 1 :a.c/d 2} 'a.b nil) ; {:c 1} 32 | ) 33 | -------------------------------------------------------------------------------- /src/com/biffweb/impl/util/reload.clj: -------------------------------------------------------------------------------- 1 | ;; The code in this file has been copied from https://github.com/jakemcc/reload 2 | ;; and is licensed under the EPL version 1.0 (or any later version). 3 | (ns com.biffweb.impl.util.reload 4 | (:require [clojure.repl :as repl] 5 | [clojure.string :as str] 6 | [clojure.tools.namespace.dir :as dir] 7 | [clojure.tools.namespace.reload :as reload] 8 | clojure.tools.namespace.repl 9 | [clojure.tools.namespace.track :as track])) 10 | 11 | (defonce global-tracker (atom (track/tracker))) 12 | 13 | (def remove-disabled #'clojure.tools.namespace.repl/remove-disabled) 14 | 15 | (defn- print-pending-reloads [tracker] 16 | (when-let [r (seq (::track/load tracker))] 17 | (prn :reloading r))) 18 | 19 | (defn print-and-return [tracker] 20 | (if-let [e (::reload/error tracker)] 21 | (do (when (thread-bound? #'*e) 22 | (set! *e e)) 23 | (prn :error-while-loading (::reload/error-ns tracker)) 24 | (repl/pst e) 25 | e) 26 | :ok)) 27 | 28 | (defn refresh [tracker directories] 29 | (let [directories (filterv (set (str/split (System/getProperty "java.class.path") #":")) directories) 30 | new-tracker (apply dir/scan tracker directories) 31 | new-tracker (remove-disabled new-tracker)] 32 | (print-pending-reloads new-tracker) 33 | (let [new-tracker (reload/track-reload (assoc new-tracker ::track/unload []))] 34 | (print-and-return new-tracker) 35 | new-tracker))) 36 | -------------------------------------------------------------------------------- /src/com/biffweb/impl/util/s3.clj: -------------------------------------------------------------------------------- 1 | (ns com.biffweb.impl.util.s3 2 | (:require [com.biffweb.impl.util :as bu] 3 | [buddy.core.mac :as mac] 4 | [clj-http.client :as http] 5 | [clojure.string :as str])) 6 | 7 | (defn hmac-sha1-base64 [secret s] 8 | (-> (mac/hash s {:key secret :alg :hmac+sha1}) 9 | bu/base64-encode)) 10 | 11 | (defn md5-base64 [body] 12 | (with-open [f (cond 13 | (string? body) (java.io.ByteArrayInputStream. (.getBytes body)) 14 | :else (java.io.FileInputStream. body))] 15 | (let [buffer (byte-array 1024) 16 | md (java.security.MessageDigest/getInstance "MD5")] 17 | (loop [nread (.read f buffer)] 18 | (if (pos? nread) 19 | (do 20 | (.update md buffer 0 nread) 21 | (recur (.read f buffer))) 22 | (bu/base64-encode (.digest md))))))) 23 | 24 | (defn body->bytes [body] 25 | (cond 26 | (string? body) (.getBytes body) 27 | :else (let [out (byte-array (.length body))] 28 | (with-open [in (java.io.FileInputStream. body)] 29 | (.read in out) 30 | out)))) 31 | 32 | (defn s3-request [{:keys [biff/secret] 33 | :biff.s3/keys [origin 34 | access-key 35 | bucket 36 | key 37 | method 38 | headers 39 | body]}] 40 | ;; See https://docs.aws.amazon.com/AmazonS3/latest/userguide/RESTAuthentication.html 41 | (let [date (.format (doto (new java.text.SimpleDateFormat "EEE, dd MMM yyyy HH:mm:ss Z") 42 | (.setTimeZone (java.util.TimeZone/getTimeZone "UTC"))) 43 | (java.util.Date.)) 44 | path (str "/" bucket "/" key) 45 | md5 (some-> body md5-base64) 46 | headers' (->> headers 47 | (mapv (fn [[k v]] 48 | [(str/trim (str/lower-case k)) (str/trim v)])) 49 | (into {})) 50 | content-type (get headers' "content-type") 51 | headers' (->> headers' 52 | (filterv (fn [[k v]] 53 | (str/starts-with? k "x-amz-"))) 54 | (sort-by first) 55 | (mapv (fn [[k v]] 56 | (str k ":" v "\n"))) 57 | (apply str)) 58 | string-to-sign (str method "\n" md5 "\n" content-type "\n" date "\n" headers' path) 59 | signature (hmac-sha1-base64 (secret :biff.s3/secret-key) string-to-sign) 60 | auth (str "AWS " access-key ":" signature) 61 | s3-opts {:method method 62 | :url (str origin path) 63 | :headers (merge {"Authorization" auth 64 | "Date" date 65 | "Content-MD5" md5} 66 | headers) 67 | :body (some-> body body->bytes)}] 68 | (http/request s3-opts))) 69 | -------------------------------------------------------------------------------- /src/com/biffweb/impl/xtdb.clj: -------------------------------------------------------------------------------- 1 | (ns com.biffweb.impl.xtdb 2 | (:require [better-cond.core :as b] 3 | [com.biffweb.impl.util :as util] 4 | [com.biffweb.impl.util.ns :as ns] 5 | [clojure.java.io :as io] 6 | [clojure.set :as set] 7 | [clojure.tools.logging :as log] 8 | [clojure.walk :as walk] 9 | [xtdb.api :as xt] 10 | [malli.error :as male] 11 | [malli.core :as malc])) 12 | 13 | (defn save-tx-fns! [node tx-fns] 14 | (let [db (xt/db node)] 15 | (when-some [tx (not-empty 16 | (vec 17 | (for [[k f] tx-fns 18 | :let [new-doc {:xt/id k 19 | :xt/fn f} 20 | old-doc (xt/entity db k)] 21 | :when (not= new-doc old-doc)] 22 | [::xt/put new-doc])))] 23 | (xt/submit-tx node tx)))) 24 | 25 | (defn start-node 26 | [{:keys [topology dir opts jdbc-spec pool-opts kv-store tx-fns] 27 | :or {kv-store :rocksdb}}] 28 | (let [kv-store-fn (fn [basename] 29 | {:kv-store {:xtdb/module (if (= kv-store :lmdb) 30 | 'xtdb.lmdb/->kv-store 31 | 'xtdb.rocksdb/->kv-store) 32 | :db-dir (io/file dir (str basename (when (= kv-store :lmdb) 33 | "-lmdb")))}}) 34 | node (xt/start-node 35 | (merge (case topology 36 | :standalone 37 | {:xtdb/index-store (kv-store-fn "index") 38 | :xtdb/document-store (kv-store-fn "docs") 39 | :xtdb/tx-log (kv-store-fn "tx-log")} 40 | 41 | :jdbc 42 | {:xtdb/index-store (kv-store-fn "index") 43 | :xtdb.jdbc/connection-pool {:dialect {:xtdb/module 44 | 'xtdb.jdbc.psql/->dialect} 45 | :pool-opts pool-opts 46 | :db-spec jdbc-spec} 47 | :xtdb/tx-log {:xtdb/module 'xtdb.jdbc/->tx-log 48 | :connection-pool :xtdb.jdbc/connection-pool} 49 | :xtdb/document-store {:xtdb/module 'xtdb.jdbc/->document-store 50 | :connection-pool :xtdb.jdbc/connection-pool}}) 51 | opts)) 52 | f (future (xt/sync node))] 53 | (while (not (realized? f)) 54 | (Thread/sleep 2000) 55 | (when-some [indexed (xt/latest-completed-tx node)] 56 | (log/info "Indexed" (pr-str indexed)))) 57 | (when (not-empty tx-fns) 58 | (save-tx-fns! node tx-fns)) 59 | node)) 60 | 61 | (defn use-xt 62 | [{:keys [biff/secret] 63 | :biff.xtdb/keys [topology dir kv-store opts tx-fns] 64 | :or {kv-store :rocksdb} 65 | :as ctx}] 66 | (let [node (start-node 67 | {:topology topology 68 | :dir dir 69 | :kv-store kv-store 70 | :opts opts 71 | :jdbc-spec (into (ns/select-ns-as ctx 'biff.xtdb.jdbc nil) 72 | (keep (fn [k] 73 | (when-let [value (and secret (secret (keyword "biff.xtdb.jdbc" (name k))))] 74 | [k value]))) 75 | [:password :jdbcUrl]) 76 | :pool-opts (ns/select-ns-as ctx 'biff.xtdb.jdbc-pool nil) 77 | :tx-fns tx-fns})] 78 | (-> ctx 79 | (assoc :biff.xtdb/node node) 80 | (update :biff/stop conj #(.close node))))) 81 | 82 | (defn assoc-db [{:keys [biff.xtdb/node] :as ctx}] 83 | (cond-> ctx 84 | node (assoc :biff/db (xt/db node)))) 85 | 86 | (defn merge-context [{:keys [biff/merge-context-fn] 87 | :or {merge-context-fn assoc-db} 88 | :as ctx}] 89 | (merge-context-fn ctx)) 90 | 91 | (defn use-tx-listener [{:keys [biff/features 92 | biff/plugins 93 | biff/modules 94 | biff.xtdb/on-tx 95 | biff.xtdb/node] 96 | :as ctx}] 97 | (if-not (or on-tx modules plugins features) 98 | ctx 99 | (let [on-tx (or on-tx 100 | (fn [ctx tx] 101 | (doseq [{:keys [on-tx]} @(or modules plugins features) 102 | :when on-tx] 103 | (util/catchall-verbose 104 | (on-tx ctx tx))))) 105 | lock (Object.) 106 | listener (xt/listen 107 | node 108 | {::xt/event-type ::xt/indexed-tx} 109 | (fn [{:keys [::xt/tx-id committed?]}] 110 | (when committed? 111 | (locking lock 112 | (with-open [log (xt/open-tx-log node 113 | (dec tx-id) 114 | true)] 115 | (let [tx (first (iterator-seq log))] 116 | (try 117 | (on-tx (merge-context ctx) tx) 118 | (catch Exception e 119 | (log/error e "Exception during on-tx")))))))))] 120 | (update ctx :biff/stop conj #(.close listener))))) 121 | 122 | (defn q [db query & args] 123 | (when-not (= (count (:in query)) 124 | (count args)) 125 | (throw (ex-info (str "Incorrect number of query arguments. Expected " 126 | (count (:in query)) 127 | " but got " 128 | (count args) 129 | ".") 130 | {}))) 131 | (let [return-tuples (vector? (:find query)) 132 | query (cond-> query 133 | (not return-tuples) (update :find vector)) 134 | results (apply xt/q db query args)] 135 | (cond->> results 136 | (not return-tuples) (map first)))) 137 | 138 | (defn lazy-q 139 | [db query & args] 140 | (when-not (= (count (:in query)) 141 | (dec (count args))) 142 | (throw (ex-info (str "Incorrect number of query arguments. Expected " 143 | (count (:in query)) 144 | " but got " 145 | (count args) 146 | ".") 147 | {}))) 148 | (let [f (last args) 149 | query-args (butlast args) 150 | return-tuples (vector? (:find query)) 151 | query (cond-> query 152 | (not return-tuples) (update :find vector))] 153 | (with-open [results (apply xt/open-q db query query-args)] 154 | (f (cond->> (iterator-seq results) 155 | (not return-tuples) (map first)))))) 156 | 157 | (defn parse-lookup-args [args] 158 | (if (vector? (first args)) 159 | args 160 | (conj args '[*]))) 161 | 162 | (defn lookup* [db opts & kvs] 163 | (let [kvs (partition 2 kvs) 164 | symbols (vec 165 | (for [i (range (count kvs))] 166 | (symbol (str "v" i))))] 167 | (apply q 168 | db 169 | (merge 170 | opts 171 | {:in symbols 172 | :where (vec 173 | (for [[[k _] sym] (map vector kvs symbols)] 174 | ['doc k sym]))}) 175 | (map second kvs)))) 176 | 177 | (defn lookup [db & args] 178 | (let [[pull-expr & kvs] (parse-lookup-args args) 179 | opts {:find (list 'pull 'doc pull-expr) 180 | :limit 1}] 181 | (first (apply lookup* db opts kvs)))) 182 | 183 | (defn lookup-all [db & args] 184 | (let [[pull-expr & kvs] (parse-lookup-args args) 185 | opts {:find (list 'pull 'doc pull-expr)}] 186 | (apply lookup* db opts kvs))) 187 | 188 | (defn lookup-id [db & kvs] 189 | (first (apply lookup* db '{:find doc :limit 1} kvs))) 190 | 191 | (defn lookup-id-all [db & kvs] 192 | (apply lookup* db '{:find doc} kvs)) 193 | 194 | (defn- special-val? [x] 195 | (or (= x :db/dissoc) 196 | (and (coll? x) 197 | (<= 2 (count x)) 198 | (#{:db/lookup 199 | :db/union 200 | :db/difference 201 | :db/add 202 | :db/default} (first x))))) 203 | 204 | (defn- apply-special-vals [doc-before doc-after] 205 | (->> (merge doc-before doc-after) 206 | (keep (fn [[k v]] 207 | (b/cond 208 | (not (special-val? v)) [k v] 209 | (= v :db/dissoc) nil 210 | :let [[op & xs] v 211 | v-before (get doc-before k)] 212 | (= op :db/union) [k (set/union (set v-before) (set xs))] 213 | (= op :db/difference) [k (set/difference (set v-before) (set xs))] 214 | (= op :db/add) [k (apply + (or v-before 0) xs)] 215 | :let [[default-value] xs] 216 | (= op :db/default) (if (contains? doc-before k) 217 | [k v-before] 218 | [k default-value])))) 219 | (into {}))) 220 | 221 | (b/defnc lookup-info [db doc-id] 222 | :let [[lookup-id default-id] (when (and (special-val? doc-id) 223 | (= :db/lookup (first doc-id))) 224 | (rest doc-id))] 225 | :when lookup-id 226 | :let [lookup-doc-before (xt/entity db lookup-id) 227 | lookup-doc-after (or lookup-doc-before 228 | {:xt/id lookup-id 229 | :db/owned-by (or default-id (java.util.UUID/randomUUID))})] 230 | [lookup-id lookup-doc-before lookup-doc-after]) 231 | 232 | ;; TODO Refactor this into smaller tx-xform-* functions 233 | (b/defnc biff-op->xt 234 | [{:keys [biff/now biff/db biff/malli-opts]} 235 | {:keys [xt/id db/doc-type db/op] :or {op :put} :as tx-doc}] 236 | ;; possible ops: delete, put, create, merge, update 237 | :let [valid? (fn [doc] (malc/validate doc-type doc @malli-opts)) 238 | explain (fn [doc] (male/humanize (malc/explain doc-type doc @malli-opts))) 239 | [lookup-id 240 | lookup-doc-before 241 | lookup-doc-after] (lookup-info db id) 242 | id (if lookup-id 243 | (:db/owned-by lookup-doc-after) 244 | (or id (java.util.UUID/randomUUID)))] 245 | (= op :delete) (concat [[::xt/delete id]] 246 | (when lookup-id 247 | [[::xt/match lookup-id lookup-doc-before] 248 | [::xt/delete lookup-id]])) 249 | 250 | ;; possible ops: put, create, merge, update 251 | (nil? doc-type) (throw (ex-info "Missing :db/doc-type." 252 | {:tx-doc tx-doc})) 253 | :let [doc-after (cond-> tx-doc 254 | (map? lookup-id) (merge lookup-id) 255 | true (dissoc :db/op :db/doc-type) 256 | true (assoc :xt/id id)) 257 | doc-after (walk/postwalk #(if (= % :db/now) now %) doc-after) 258 | lookup-ops (when lookup-id 259 | [[::xt/match lookup-id lookup-doc-before] 260 | [::xt/put lookup-doc-after]])] 261 | :do (cond 262 | (not= op :put) nil, 263 | 264 | (some special-val? (vals doc-after)) 265 | (throw (ex-info "Attempted to use a special value on a :put operation" 266 | {:tx-doc tx-doc})), 267 | 268 | (not (valid? doc-after)) 269 | (throw (ex-info (str "Doc wouldn't be a valid " doc-type " after transaction.") 270 | {:tx-doc tx-doc 271 | :explain (explain doc-after)}))) 272 | (= op :put) (concat [[::xt/put doc-after]] lookup-ops) 273 | 274 | ;; possible ops: create, merge, update 275 | :let [doc-before (xt/entity db id)] 276 | :do (cond 277 | (not= op :create) nil, 278 | 279 | (some? doc-before) (throw (ex-info "Attempted to create over an existing doc." 280 | {:tx-doc tx-doc})), 281 | 282 | (some special-val? (vals doc-after)) 283 | (throw (ex-info "Attempted to use a special value on a :create operation" 284 | {:tx-doc tx-doc})), 285 | 286 | (not (valid? doc-after)) 287 | (throw (ex-info (str "Doc wouldn't be a valid " doc-type " after transaction.") 288 | {:tx-doc tx-doc 289 | :explain (explain doc-after)}))) 290 | (= op :create) (concat [[::xt/match id nil] 291 | [::xt/put doc-after]] 292 | lookup-ops) 293 | 294 | ;; possible ops: merge, update 295 | (and (= op :update) 296 | (nil? doc-before)) (throw (ex-info "Attempted to update on a new doc." 297 | {:tx-doc tx-doc})) 298 | :let [doc-after (apply-special-vals doc-before doc-after)] 299 | (not (valid? doc-after)) (throw (ex-info (str "Doc wouldn't be a valid " doc-type " after transaction.") 300 | {:tx-doc tx-doc 301 | :explain (explain doc-after)})) 302 | :else (concat [[::xt/match id doc-before] 303 | [::xt/put doc-after]] 304 | lookup-ops)) 305 | 306 | (defn tx-xform-tmp-ids [_ tx] 307 | (let [tmp-ids (->> tx 308 | (tree-seq (some-fn list? 309 | #(instance? clojure.lang.IMapEntry %) 310 | seq? 311 | #(instance? clojure.lang.IRecord %) 312 | coll?) 313 | identity) 314 | (filter (fn [x] 315 | (and (keyword? x) (= "db.id" (namespace x))))) 316 | distinct 317 | (map (fn [x] 318 | [x (java.util.UUID/randomUUID)])) 319 | (into {}))] 320 | (cond->> tx 321 | (not-empty tmp-ids) (walk/postwalk #(get tmp-ids % %))))) 322 | 323 | (defn tx-xform-upsert [{:keys [biff/db]} tx] 324 | (mapcat 325 | (fn [op] 326 | (if-some [m (:db.op/upsert op)] 327 | (let [kvs (apply concat m) 328 | id (apply lookup-id db kvs) 329 | doc (-> (apply assoc op kvs) 330 | (assoc :db/op :merge) 331 | (dissoc :db.op/upsert))] 332 | (if (nil? id) 333 | [doc [::xt/fn :biff/ensure-unique m]] 334 | [(assoc doc :xt/id id)])) 335 | [op])) 336 | tx)) 337 | 338 | (defn tx-xform-unique [_ tx] 339 | (mapcat 340 | (fn [op] 341 | (if-let [entries (and (map? op) 342 | (->> op 343 | (keep (fn [[k v]] 344 | (when (and (vector? v) 345 | (= (first v) :db/unique)) 346 | [k (second v)]))) 347 | not-empty))] 348 | (concat 349 | [(into op entries)] 350 | (for [[k v] entries] 351 | [::xt/fn :biff/ensure-unique {k v}])) 352 | [op])) 353 | tx)) 354 | 355 | (defn tx-xform-main [ctx tx] 356 | (mapcat 357 | (fn [op] 358 | (if (map? op) 359 | (biff-op->xt ctx op) 360 | [op])) 361 | tx)) 362 | 363 | (def default-tx-transformers 364 | [tx-xform-tmp-ids 365 | tx-xform-upsert 366 | tx-xform-unique 367 | tx-xform-main]) 368 | 369 | (defn biff-tx->xt [{:keys [biff.xtdb/transformers] 370 | :or {transformers default-tx-transformers} 371 | :as ctx} 372 | biff-tx] 373 | (reduce (fn [tx xform] 374 | (xform ctx tx)) 375 | (if (fn? biff-tx) 376 | (biff-tx ctx) 377 | biff-tx) 378 | transformers)) 379 | 380 | (defn submit-with-retries [ctx make-tx] 381 | (let [{:keys [biff.xtdb/node 382 | biff/db 383 | ::n-tried] 384 | :or {n-tried 0} 385 | :as ctx} (-> (assoc-db ctx) 386 | (assoc :biff/now (java.util.Date.))) 387 | tx (make-tx ctx) 388 | _ (when (and (some (fn [[op]] 389 | (= op ::xt/fn)) 390 | tx) 391 | (nil? (xt/with-tx db tx))) 392 | (throw (ex-info "Transaction violated a constraint" {:tx tx}))) 393 | submitted-tx (when (not-empty tx) 394 | (xt/submit-tx node tx)) 395 | ms (int (rand (* 1000 (Math/pow 2 n-tried))))] 396 | (when submitted-tx 397 | (xt/await-tx node submitted-tx)) 398 | (cond 399 | (or (nil? submitted-tx) 400 | (xt/tx-committed? node submitted-tx)) submitted-tx 401 | (<= 4 n-tried) (throw (ex-info "TX failed, too much contention." {:tx tx})) 402 | :else (do 403 | (log/warnf "TX failed due to contention, trying again in %d ms...\n" 404 | ms) 405 | (flush) 406 | (Thread/sleep ms) 407 | (recur (update ctx ::n-tried (fnil inc 0)) make-tx))))) 408 | 409 | (defn submit-tx [{:keys [biff.xtdb/retry biff.xtdb/node] 410 | :or {retry true} 411 | :as ctx} biff-tx] 412 | (if retry 413 | (submit-with-retries ctx #(biff-tx->xt % biff-tx)) 414 | (xt/submit-tx node (-> (assoc-db ctx) 415 | (assoc :biff/now (java.util.Date.)) 416 | (biff-tx->xt biff-tx))))) 417 | 418 | (def tx-fns 419 | {:biff/ensure-unique 420 | '(fn [ctx kvs] 421 | (let [kvs (for [[i [k v]] (map-indexed vector kvs) 422 | :let [sym (symbol (str "v" i))]] 423 | {:k k 424 | :v v 425 | :sym sym}) 426 | query {:find '[doc], 427 | :limit 2, 428 | :in (mapv :sym kvs) 429 | :where (vec 430 | (for [{:keys [k sym]} kvs] 431 | ['doc k sym]))}] 432 | (when (< 1 (count (apply xtdb.api/q 433 | (xtdb.api/db ctx) 434 | query 435 | (map :v kvs)))) 436 | false)))}) 437 | 438 | (defn test-node [docs] 439 | (let [node (xt/start-node {})] 440 | (xt/await-tx 441 | node 442 | (xt/submit-tx node 443 | (vec 444 | (concat 445 | (for [d docs] 446 | [::xt/put (merge {:xt/id (random-uuid)} 447 | d)]) 448 | (for [[k f] tx-fns] 449 | [::xt/put {:xt/id k :xt/fn f}]))))) 450 | node)) 451 | -------------------------------------------------------------------------------- /starter/.dockerignore: -------------------------------------------------------------------------------- 1 | .git 2 | node_modules 3 | .cpcache 4 | -------------------------------------------------------------------------------- /starter/.gitignore: -------------------------------------------------------------------------------- 1 | /.cpcache 2 | /.nrepl-port 3 | /bin 4 | /config.edn 5 | /config.sh 6 | /config.env 7 | /node_modules 8 | /secrets.env 9 | /storage/ 10 | /tailwindcss 11 | /target 12 | .calva/ 13 | .clj-kondo/ 14 | .lsp/ 15 | .portal/ 16 | .shadow-cljs/ 17 | -------------------------------------------------------------------------------- /starter/Dockerfile: -------------------------------------------------------------------------------- 1 | # The default deploy instructions (https://biffweb.com/docs/reference/production/) don't 2 | # use Docker, but this file is provided in case you'd like to deploy with containers. 3 | # 4 | # When running the container, make sure you set any environment variables defined in config.env, 5 | # e.g. using whatever tools your deployment platform provides for setting environment variables. 6 | # 7 | # Run these commands to test this file locally: 8 | # 9 | # docker build -t your-app . 10 | # docker run --rm -e BIFF_PROFILE=dev -v $PWD/config.env:/app/config.env your-app 11 | 12 | # This is the base builder image, construct the jar file in this one 13 | # it uses alpine for a small image 14 | FROM clojure:temurin-21-tools-deps-alpine AS jre-build 15 | 16 | ENV TAILWIND_VERSION=v3.2.4 17 | 18 | # Install the missing packages and applications in a single layer 19 | RUN apk add curl rlwrap && curl -L -o /usr/local/bin/tailwindcss \ 20 | https://github.com/tailwindlabs/tailwindcss/releases/download/$TAILWIND_VERSION/tailwindcss-linux-x64 \ 21 | && chmod +x /usr/local/bin/tailwindcss 22 | 23 | WORKDIR /app 24 | COPY src ./src 25 | COPY dev ./dev 26 | COPY resources ./resources 27 | COPY deps.edn . 28 | 29 | # construct the application jar 30 | RUN clj -M:dev uberjar && cp target/jar/app.jar . && rm -r target 31 | 32 | # This stage (see multi-stage builds) is a bare Java container 33 | # copy over the uberjar from the builder image and run the application 34 | FROM eclipse-temurin:21-alpine 35 | WORKDIR /app 36 | 37 | # Take the uberjar from the base image and put it in the final image 38 | COPY --from=jre-build /app/app.jar /app/app.jar 39 | 40 | EXPOSE 8080 41 | 42 | # By default, run in PROD profile 43 | ENV BIFF_PROFILE=prod 44 | ENV HOST=0.0.0.0 45 | ENV PORT=8080 46 | CMD ["/opt/java/openjdk/bin/java", "-XX:-OmitStackTraceInFastThrow", "-XX:+CrashOnOutOfMemoryError", "-jar", "app.jar"] 47 | -------------------------------------------------------------------------------- /starter/README.md: -------------------------------------------------------------------------------- 1 | # Biff starter project 2 | 3 | This is the starter project for Biff. 4 | 5 | Run `clj -M:dev dev` to get started. See `clj -M:dev --help` for other commands. 6 | 7 | Consider adding `alias biff='clj -M:dev'` to your `.bashrc`. 8 | -------------------------------------------------------------------------------- /starter/cljfmt-indents.edn: -------------------------------------------------------------------------------- 1 | {submit-tx [[:inner 0]]} 2 | -------------------------------------------------------------------------------- /starter/deps.edn: -------------------------------------------------------------------------------- 1 | {:paths ["src" "resources" "target/resources"] 2 | :deps {com.biffweb/biff {:local/root ".."} 3 | camel-snake-kebab/camel-snake-kebab {:mvn/version "0.4.3"} 4 | metosin/muuntaja {:mvn/version "0.6.8"} 5 | ring/ring-defaults {:mvn/version "0.3.4"} 6 | org.clojure/clojure {:mvn/version "1.11.1"} 7 | 8 | ;; Notes on logging: https://gist.github.com/jacobobryant/76b7a08a07d5ef2cc076b048d078f1f3 9 | org.slf4j/slf4j-simple {:mvn/version "2.0.0-alpha5"} 10 | org.slf4j/log4j-over-slf4j {:mvn/version "1.7.36"} 11 | org.slf4j/jul-to-slf4j {:mvn/version "1.7.36"} 12 | org.slf4j/jcl-over-slf4j {:mvn/version "1.7.36"}} 13 | :aliases 14 | {:dev {:extra-deps {com.biffweb/tasks {:local/root "../libs/tasks"}} 15 | :extra-paths ["dev" "test"] 16 | :jvm-opts ["-XX:-OmitStackTraceInFastThrow" 17 | "-XX:+CrashOnOutOfMemoryError" 18 | "-Dbiff.env.BIFF_PROFILE=dev"] 19 | :main-opts ["-m" "com.biffweb.task-runner" "tasks/tasks"]} 20 | :prod {:jvm-opts ["-XX:-OmitStackTraceInFastThrow" 21 | "-XX:+CrashOnOutOfMemoryError" 22 | "-Dbiff.env.BIFF_PROFILE=prod"] 23 | :main-opts ["-m" "com.example"]}}} 24 | -------------------------------------------------------------------------------- /starter/dev/repl.clj: -------------------------------------------------------------------------------- 1 | (ns repl 2 | (:require [com.example :as main] 3 | [com.biffweb :as biff :refer [q]] 4 | [clojure.edn :as edn] 5 | [clojure.java.io :as io])) 6 | 7 | ;; REPL-driven development 8 | ;; ---------------------------------------------------------------------------------------- 9 | ;; If you're new to REPL-driven development, Biff makes it easy to get started: whenever 10 | ;; you save a file, your changes will be evaluated. Biff is structured so that in most 11 | ;; cases, that's all you'll need to do for your changes to take effect. (See main/refresh 12 | ;; below for more details.) 13 | ;; 14 | ;; The `clj -M:dev dev` command also starts an nREPL server on port 7888, so if you're 15 | ;; already familiar with REPL-driven development, you can connect to that with your editor. 16 | ;; 17 | ;; If you're used to jacking in with your editor first and then starting your app via the 18 | ;; REPL, you will need to instead connect your editor to the nREPL server that `clj -M:dev 19 | ;; dev` starts. e.g. if you use emacs, instead of running `cider-jack-in`, you would run 20 | ;; `cider-connect`. See "Connecting to a Running nREPL Server:" 21 | ;; https://docs.cider.mx/cider/basics/up_and_running.html#connect-to-a-running-nrepl-server 22 | ;; ---------------------------------------------------------------------------------------- 23 | 24 | ;; This function should only be used from the REPL. Regular application code 25 | ;; should receive the system map from the parent Biff component. For example, 26 | ;; the use-jetty component merges the system map into incoming Ring requests. 27 | (defn get-context [] 28 | (biff/merge-context @main/system)) 29 | 30 | (defn add-fixtures [] 31 | (biff/submit-tx (get-context) 32 | (-> (io/resource "fixtures.edn") 33 | slurp 34 | edn/read-string))) 35 | 36 | (defn check-config [] 37 | (let [prod-config (biff/use-aero-config {:biff.config/profile "prod"}) 38 | dev-config (biff/use-aero-config {:biff.config/profile "dev"}) 39 | ;; Add keys for any other secrets you've added to resources/config.edn 40 | secret-keys [:biff.middleware/cookie-secret 41 | :biff/jwt-secret 42 | :mailersend/api-key 43 | :recaptcha/secret-key 44 | ; ... 45 | ] 46 | get-secrets (fn [{:keys [biff/secret] :as config}] 47 | (into {} 48 | (map (fn [k] 49 | [k (secret k)])) 50 | secret-keys))] 51 | {:prod-config prod-config 52 | :dev-config dev-config 53 | :prod-secrets (get-secrets prod-config) 54 | :dev-secrets (get-secrets dev-config)})) 55 | 56 | (comment 57 | ;; Call this function if you make a change to main/initial-system, 58 | ;; main/components, :tasks, :queues, config.env, or deps.edn. 59 | (main/refresh) 60 | 61 | ;; Call this in dev if you'd like to add some seed data to your database. If 62 | ;; you edit the seed data (in resources/fixtures.edn), you can reset the 63 | ;; database by running `rm -r storage/xtdb` (DON'T run that in prod), 64 | ;; restarting your app, and calling add-fixtures again. 65 | (add-fixtures) 66 | 67 | ;; Query the database 68 | (let [{:keys [biff/db] :as ctx} (get-context)] 69 | (q db 70 | '{:find (pull user [*]) 71 | :where [[user :user/email]]})) 72 | 73 | ;; Update an existing user's email address 74 | (let [{:keys [biff/db] :as ctx} (get-context) 75 | user-id (biff/lookup-id db :user/email "hello@example.com")] 76 | (biff/submit-tx ctx 77 | [{:db/doc-type :user 78 | :xt/id user-id 79 | :db/op :update 80 | :user/email "new.address@example.com"}])) 81 | 82 | (sort (keys (get-context))) 83 | 84 | ;; Check the terminal for output. 85 | (biff/submit-job (get-context) :echo {:foo "bar"}) 86 | (deref (biff/submit-job-for-result (get-context) :echo {:foo "bar"}))) 87 | -------------------------------------------------------------------------------- /starter/dev/tasks.clj: -------------------------------------------------------------------------------- 1 | (ns tasks 2 | (:require [com.biffweb.tasks :as tasks])) 3 | 4 | (defn hello 5 | "Says 'Hello'" 6 | [] 7 | (println "Hello")) 8 | 9 | ;; Tasks should be vars (#'hello instead of hello) so that `clj -M:dev help` can 10 | ;; print their docstrings. 11 | (def custom-tasks 12 | {"hello" #'hello}) 13 | 14 | (def tasks (merge tasks/tasks custom-tasks)) 15 | -------------------------------------------------------------------------------- /starter/resources/config.edn: -------------------------------------------------------------------------------- 1 | ;; See https://github.com/juxt/aero and https://biffweb.com/docs/api/utilities/#use-aero-config. 2 | ;; #biff/env and #biff/secret will load values from the environment and from config.env. 3 | {:biff/base-url #profile {:prod #join ["https://" #biff/env DOMAIN] 4 | :default #join ["http://localhost:" #ref [:biff/port]]} 5 | :biff/host #or [#biff/env "HOST" 6 | #profile {:dev "0.0.0.0" 7 | :default "localhost"}] 8 | :biff/port #long #or [#biff/env "PORT" 8080] 9 | 10 | :biff.xtdb/dir "storage/xtdb" 11 | :biff.xtdb/topology #keyword #or [#profile {:prod #biff/env "PROD_XTDB_TOPOLOGY" 12 | :default #biff/env "XTDB_TOPOLOGY"} 13 | "standalone"] 14 | :biff.xtdb.jdbc/jdbcUrl #biff/secret "XTDB_JDBC_URL" 15 | 16 | :biff.beholder/enabled #profile {:dev true :default false} 17 | :biff.beholder/paths ["src" "resources" "test"] 18 | :biff/eval-paths ["src" "test"] 19 | :biff.middleware/secure #profile {:dev false :default true} 20 | :biff.middleware/cookie-secret #biff/secret COOKIE_SECRET 21 | :biff/jwt-secret #biff/secret JWT_SECRET 22 | :biff.refresh/enabled #profile {:dev true :default false} 23 | 24 | :mailersend/api-key #biff/secret MAILERSEND_API_KEY 25 | :mailersend/from #biff/env MAILERSEND_FROM 26 | :mailersend/reply-to #biff/env MAILERSEND_REPLY_TO 27 | 28 | :recaptcha/secret-key #biff/secret RECAPTCHA_SECRET_KEY 29 | :recaptcha/site-key #biff/env RECAPTCHA_SITE_KEY 30 | 31 | :biff.nrepl/port #or [#biff/env NREPL_PORT "7888"] 32 | :biff.nrepl/args ["--port" #ref [:biff.nrepl/port] 33 | "--middleware" "[cider.nrepl/cider-middleware,refactor-nrepl.middleware/wrap-refactor]"] 34 | 35 | :biff.system-properties/user.timezone "UTC" 36 | :biff.system-properties/clojure.tools.logging.factory "clojure.tools.logging.impl/slf4j-factory" 37 | 38 | :biff.tasks/server #biff/env DOMAIN 39 | :biff.tasks/main-ns com.example 40 | :biff.tasks/on-soft-deploy "\"(com.example/on-save @com.example/system)\"" 41 | :biff.tasks/generate-assets-fn com.example/generate-assets! 42 | :biff.tasks/css-output "target/resources/public/css/main.css" 43 | :biff.tasks/deploy-untracked-files [#ref [:biff.tasks/css-output] 44 | "config.env"] 45 | 46 | ;; `clj -M:dev prod-dev` will run the soft-deploy task whenever files in these directories are changed. 47 | :biff.tasks/watch-dirs ["src" "dev" "resources" "test"] 48 | 49 | ;; The version of the Taliwind standalone bin to install. See `clj -M:dev css -h`. If you change 50 | ;; this, run `rm bin/tailwindcss; clj -M:dev install-tailwind`. 51 | :biff.tasks/tailwind-version "v3.4.17" 52 | 53 | ;; :rsync is the default if rsync is on the path; otherwise :git is the default. Set this to :git 54 | ;; if you have rsync on the path but still want to deploy with git. 55 | ;; :biff.tasks/deploy-with :rsync 56 | 57 | ;; Uncomment this line if you're deploying with git and your local branch is called main instead of 58 | ;; master: 59 | ;; :biff.tasks/git-deploy-cmd ["git" "push" "prod" "main:master"] 60 | :biff.tasks/git-deploy-cmd ["git" "push" "prod" "master"] 61 | 62 | ;; Uncomment this line if you have any ssh-related problems: 63 | ;; :biff.tasks/skip-ssh-agent true 64 | } 65 | -------------------------------------------------------------------------------- /starter/resources/config.template.env: -------------------------------------------------------------------------------- 1 | # This file contains config that is not checked into git. See resources/config.edn for more config 2 | # options. 3 | 4 | # Where will your app be deployed? 5 | DOMAIN=example.com 6 | 7 | # Mailersend is used to send email sign-in links. Sign up at https://www.mailersend.com/ 8 | MAILERSEND_API_KEY= 9 | # This must be an email address that uses the same domain that you've verified in MailerSend. 10 | MAILERSEND_FROM= 11 | # This is where emails will be sent when users hit reply. It can be any email address. 12 | MAILERSEND_REPLY_TO= 13 | 14 | # Recaptcha is used to protect your sign-in page from bots. Go to 15 | # https://www.google.com/recaptcha/about/ and add a site. Select v2 invisible. Add localhost and the 16 | # value of DOMAIN above to your list of allowed domains. 17 | RECAPTCHA_SITE_KEY= 18 | RECAPTCHA_SECRET_KEY= 19 | 20 | XTDB_TOPOLOGY=standalone 21 | # Uncomment these to use Postgres for storage in production: 22 | #PROD_XTDB_TOPOLOGY=jdbc 23 | #XTDB_JDBC_URL=jdbc:postgresql://host:port/dbname?user=alice&password=abc123&sslmode=require 24 | 25 | # What port should the nrepl server be started on (in dev and prod)? 26 | NREPL_PORT=7888 27 | 28 | 29 | ## Autogenerated. Create new secrets with `clj -M:dev generate-secrets` 30 | 31 | # Used to encrypt session cookies. 32 | COOKIE_SECRET={{ new-secret 16 }} 33 | # Used to encrypt email sign-in links. 34 | JWT_SECRET={{ new-secret 32 }} 35 | -------------------------------------------------------------------------------- /starter/resources/fixtures.edn: -------------------------------------------------------------------------------- 1 | ;; Biff transaction. See https://biffweb.com/docs/reference/transactions/ 2 | [{:db/doc-type :user 3 | :xt/id :db.id/user-a 4 | :user/email "a@example.com" 5 | :user/foo "Some Value" 6 | :user/joined-at :db/now} 7 | {:db/doc-type :msg 8 | :msg/user :db.id/user-a 9 | :msg/text "hello there" 10 | :msg/sent-at :db/now}] 11 | -------------------------------------------------------------------------------- /starter/resources/public/img/glider.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jacobobryant/biff/1570ccc694c610422d70f4b63eeaa2ba456889ac/starter/resources/public/img/glider.png -------------------------------------------------------------------------------- /starter/resources/public/js/main.js: -------------------------------------------------------------------------------- 1 | // When plain htmx isn't quite enough, you can stick some custom JS here. 2 | -------------------------------------------------------------------------------- /starter/resources/tailwind.config.js: -------------------------------------------------------------------------------- 1 | module.exports = { 2 | content: [ 3 | './src/**/*', 4 | './resources/**/*', 5 | ], 6 | theme: { 7 | extend: {}, 8 | }, 9 | plugins: [ 10 | require('@tailwindcss/forms'), 11 | ], 12 | } 13 | -------------------------------------------------------------------------------- /starter/resources/tailwind.css: -------------------------------------------------------------------------------- 1 | @tailwind base; 2 | @tailwind components; 3 | @tailwind utilities; 4 | 5 | @layer base { 6 | p { 7 | @apply mb-3; 8 | } 9 | 10 | ul { 11 | @apply list-disc; 12 | } 13 | 14 | ol { 15 | @apply list-decimal; 16 | } 17 | 18 | ul, ol { 19 | @apply my-3 pl-10; 20 | } 21 | } 22 | 23 | @layer components { 24 | .btn { 25 | @apply bg-blue-500 hover:bg-blue-700 text-center py-2 px-4 rounded disabled:opacity-50 text-white; 26 | } 27 | } 28 | 29 | @layer utilities { 30 | .link { 31 | @apply text-blue-600 hover:underline; 32 | } 33 | } 34 | 35 | .grecaptcha-badge { visibility: hidden; } 36 | -------------------------------------------------------------------------------- /starter/server-setup.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | set -x 3 | set -e 4 | 5 | BIFF_PROFILE=${1:-prod} 6 | CLJ_VERSION=1.11.1.1165 7 | TRENCH_VERSION=0.4.0 8 | if [ $(uname -m) = "aarch64" ]; then 9 | ARCH=arm64 10 | else 11 | ARCH=amd64 12 | fi 13 | TRENCH_FILE=trenchman_${TRENCH_VERSION}_linux_${ARCH}.tar.gz 14 | 15 | echo waiting for apt to finish 16 | while (ps aux | grep [a]pt); do 17 | sleep 3 18 | done 19 | 20 | # Dependencies 21 | apt-get update 22 | apt-get upgrade 23 | apt-get -y install default-jre rlwrap ufw git snapd 24 | bash < <(curl -s https://download.clojure.org/install/linux-install-$CLJ_VERSION.sh) 25 | bash < <(curl -s https://raw.githubusercontent.com/babashka/babashka/master/install) 26 | curl -sSLf https://github.com/athos/trenchman/releases/download/v$TRENCH_VERSION/$TRENCH_FILE | tar zxvfC - /usr/local/bin trench 27 | 28 | # Non-root user 29 | useradd -m app 30 | mkdir -m 700 -p /home/app/.ssh 31 | cp /root/.ssh/authorized_keys /home/app/.ssh 32 | chown -R app:app /home/app/.ssh 33 | 34 | # Git deploys - only used if you don't have rsync on your machine 35 | set_up_app () { 36 | cd 37 | mkdir repo.git 38 | cd repo.git 39 | git init --bare 40 | cat > hooks/post-receive << EOD 41 | #!/usr/bin/env bash 42 | git --work-tree=/home/app --git-dir=/home/app/repo.git checkout -f 43 | EOD 44 | chmod +x hooks/post-receive 45 | } 46 | sudo -u app bash -c "$(declare -f set_up_app); set_up_app" 47 | 48 | # Systemd service 49 | cat > /etc/systemd/system/app.service << EOD 50 | [Unit] 51 | Description=app 52 | StartLimitIntervalSec=500 53 | StartLimitBurst=5 54 | 55 | [Service] 56 | User=app 57 | Restart=on-failure 58 | RestartSec=5s 59 | Environment="BIFF_PROFILE=$BIFF_PROFILE" 60 | WorkingDirectory=/home/app 61 | ExecStart=/bin/sh -c "mkdir -p target/resources; clj -M:prod" 62 | 63 | [Install] 64 | WantedBy=multi-user.target 65 | EOD 66 | systemctl enable app 67 | cat > /etc/systemd/journald.conf << EOD 68 | [Journal] 69 | Storage=persistent 70 | EOD 71 | systemctl restart systemd-journald 72 | cat > /etc/sudoers.d/restart-app << EOD 73 | app ALL= NOPASSWD: /bin/systemctl reset-failed app.service 74 | app ALL= NOPASSWD: /bin/systemctl restart app 75 | app ALL= NOPASSWD: /usr/bin/systemctl reset-failed app.service 76 | app ALL= NOPASSWD: /usr/bin/systemctl restart app 77 | EOD 78 | chmod 440 /etc/sudoers.d/restart-app 79 | 80 | # Firewall 81 | ufw allow OpenSSH 82 | ufw --force enable 83 | 84 | # Web dependencies 85 | apt-get -y install nginx 86 | snap install core 87 | snap refresh core 88 | snap install --classic certbot 89 | ln -s /snap/bin/certbot /usr/bin/certbot 90 | 91 | # Nginx 92 | rm /etc/nginx/sites-enabled/default 93 | cat > /etc/nginx/sites-available/app << EOD 94 | server { 95 | listen 80 default_server; 96 | listen [::]:80 default_server; 97 | server_name _; 98 | gzip_types text/plain text/css application/json application/javascript text/xml application/xml application/xml+rss text/javascript; 99 | root /home/app/target/resources/public; 100 | location / { 101 | try_files \$uri \$uri/index.html @resources; 102 | } 103 | location @resources { 104 | root /home/app/resources/public; 105 | try_files \$uri \$uri/index.html @proxy; 106 | } 107 | location @proxy { 108 | proxy_pass http://localhost:8080; 109 | proxy_http_version 1.1; 110 | proxy_set_header Host \$host; 111 | proxy_set_header Upgrade \$http_upgrade; 112 | proxy_set_header Connection "Upgrade"; 113 | proxy_set_header X-Real-IP \$remote_addr; 114 | } 115 | } 116 | EOD 117 | ln -s /etc/nginx/sites-{available,enabled}/app 118 | 119 | # Firewall 120 | ufw allow "Nginx Full" 121 | 122 | # Let's encrypt 123 | certbot --nginx 124 | 125 | # App dependencies 126 | # If you need to install additional packages for your app, you can do it here. 127 | # apt-get -y install ... 128 | -------------------------------------------------------------------------------- /starter/src/com/example.clj: -------------------------------------------------------------------------------- 1 | (ns com.example 2 | (:require [com.biffweb :as biff] 3 | [com.example.email :as email] 4 | [com.example.app :as app] 5 | [com.example.home :as home] 6 | [com.example.middleware :as mid] 7 | [com.example.ui :as ui] 8 | [com.example.worker :as worker] 9 | [com.example.schema :as schema] 10 | [clojure.test :as test] 11 | [clojure.tools.logging :as log] 12 | [clojure.tools.namespace.repl :as tn-repl] 13 | [malli.core :as malc] 14 | [malli.registry :as malr] 15 | [nrepl.cmdline :as nrepl-cmd]) 16 | (:gen-class)) 17 | 18 | (def modules 19 | [app/module 20 | (biff/authentication-module {}) 21 | home/module 22 | schema/module 23 | worker/module]) 24 | 25 | (def routes [["" {:middleware [mid/wrap-site-defaults]} 26 | (keep :routes modules)] 27 | ["" {:middleware [mid/wrap-api-defaults]} 28 | (keep :api-routes modules)]]) 29 | 30 | (def handler (-> (biff/reitit-handler {:routes routes}) 31 | mid/wrap-base-defaults)) 32 | 33 | (def static-pages (apply biff/safe-merge (map :static modules))) 34 | 35 | (defn generate-assets! [ctx] 36 | (biff/export-rum static-pages "target/resources/public") 37 | (biff/delete-old-files {:dir "target/resources/public" 38 | :exts [".html"]})) 39 | 40 | (defn on-save [ctx] 41 | (biff/add-libs) 42 | (biff/eval-files! ctx) 43 | (generate-assets! ctx) 44 | (test/run-all-tests #"com.example.*-test")) 45 | 46 | (def malli-opts 47 | {:registry (malr/composite-registry 48 | malc/default-registry 49 | (apply biff/safe-merge (keep :schema modules)))}) 50 | 51 | (def initial-system 52 | {:biff/modules #'modules 53 | :biff/send-email #'email/send-email 54 | :biff/handler #'handler 55 | :biff/malli-opts #'malli-opts 56 | :biff.beholder/on-save #'on-save 57 | :biff.middleware/on-error #'ui/on-error 58 | :biff.xtdb/tx-fns biff/tx-fns 59 | :com.example/chat-clients (atom #{})}) 60 | 61 | (defonce system (atom {})) 62 | 63 | (def components 64 | [biff/use-aero-config 65 | biff/use-xtdb 66 | biff/use-queues 67 | biff/use-xtdb-tx-listener 68 | biff/use-htmx-refresh 69 | biff/use-jetty 70 | biff/use-chime 71 | biff/use-beholder]) 72 | 73 | (defn start [] 74 | (let [new-system (reduce (fn [system component] 75 | (log/info "starting:" (str component)) 76 | (component system)) 77 | initial-system 78 | components)] 79 | (reset! system new-system) 80 | (generate-assets! new-system) 81 | (log/info "System started.") 82 | (log/info "Go to" (:biff/base-url new-system)) 83 | new-system)) 84 | 85 | (defn -main [] 86 | (let [{:keys [biff.nrepl/args]} (start)] 87 | (apply nrepl-cmd/-main args))) 88 | 89 | (defn refresh [] 90 | (doseq [f (:biff/stop @system)] 91 | (log/info "stopping:" (str f)) 92 | (f)) 93 | (tn-repl/refresh :after `start) 94 | :done) 95 | -------------------------------------------------------------------------------- /starter/src/com/example/app.clj: -------------------------------------------------------------------------------- 1 | (ns com.example.app 2 | (:require [com.biffweb :as biff :refer [q]] 3 | [com.example.middleware :as mid] 4 | [com.example.ui :as ui] 5 | [com.example.settings :as settings] 6 | [rum.core :as rum] 7 | [xtdb.api :as xt] 8 | [ring.adapter.jetty9 :as jetty] 9 | [cheshire.core :as cheshire])) 10 | 11 | (defn set-foo [{:keys [session params] :as ctx}] 12 | (biff/submit-tx ctx 13 | [{:db/op :update 14 | :db/doc-type :user 15 | :xt/id (:uid session) 16 | :user/foo (:foo params)}]) 17 | {:status 303 18 | :headers {"location" "/app"}}) 19 | 20 | (defn bar-form [{:keys [value]}] 21 | (biff/form 22 | {:hx-post "/app/set-bar" 23 | :hx-swap "outerHTML"} 24 | [:label.block {:for "bar"} "Bar: " 25 | [:span.font-mono (pr-str value)]] 26 | [:.h-1] 27 | [:.flex 28 | [:input.w-full#bar {:type "text" :name "bar" :value value}] 29 | [:.w-3] 30 | [:button.btn {:type "submit"} "Update"]] 31 | [:.h-1] 32 | [:.text-sm.text-gray-600 33 | "This demonstrates updating a value with HTMX."])) 34 | 35 | (defn set-bar [{:keys [session params] :as ctx}] 36 | (biff/submit-tx ctx 37 | [{:db/op :update 38 | :db/doc-type :user 39 | :xt/id (:uid session) 40 | :user/bar (:bar params)}]) 41 | (biff/render (bar-form {:value (:bar params)}))) 42 | 43 | (defn message [{:msg/keys [text sent-at]}] 44 | [:.mt-3 {:_ "init send newMessage to #message-header"} 45 | [:.text-gray-600 (biff/format-date sent-at "dd MMM yyyy HH:mm:ss")] 46 | [:div text]]) 47 | 48 | (defn notify-clients [{:keys [com.example/chat-clients]} tx] 49 | (doseq [[op & args] (::xt/tx-ops tx) 50 | :when (= op ::xt/put) 51 | :let [[doc] args] 52 | :when (contains? doc :msg/text) 53 | :let [html (rum/render-static-markup 54 | [:div#messages {:hx-swap-oob "afterbegin"} 55 | (message doc)])] 56 | ws @chat-clients] 57 | (jetty/send! ws html))) 58 | 59 | (defn send-message [{:keys [session] :as ctx} {:keys [text]}] 60 | (let [{:keys [text]} (cheshire/parse-string text true)] 61 | (biff/submit-tx ctx 62 | [{:db/doc-type :msg 63 | :msg/user (:uid session) 64 | :msg/text text 65 | :msg/sent-at :db/now}]))) 66 | 67 | (defn chat [{:keys [biff/db]}] 68 | (let [messages (q db 69 | '{:find (pull msg [*]) 70 | :in [t0] 71 | :where [[msg :msg/sent-at t] 72 | [(<= t0 t)]]} 73 | (biff/add-seconds (java.util.Date.) (* -60 10)))] 74 | [:div {:hx-ext "ws" :ws-connect "/app/chat"} 75 | [:form.mb-0 {:ws-send true 76 | :_ "on submit set value of #message to ''"} 77 | [:label.block {:for "message"} "Write a message"] 78 | [:.h-1] 79 | [:textarea.w-full#message {:name "text"}] 80 | [:.h-1] 81 | [:.text-sm.text-gray-600 82 | "Sign in with an incognito window to have a conversation with yourself."] 83 | [:.h-2] 84 | [:div [:button.btn {:type "submit"} "Send message"]]] 85 | [:.h-6] 86 | [:div#message-header 87 | {:_ "on newMessage put 'Messages sent in the past 10 minutes:' into me"} 88 | (if (empty? messages) 89 | "No messages yet." 90 | "Messages sent in the past 10 minutes:")] 91 | [:div#messages 92 | (map message (sort-by :msg/sent-at #(compare %2 %1) messages))]])) 93 | 94 | (defn app [{:keys [session biff/db] :as ctx}] 95 | (let [{:user/keys [email foo bar]} (xt/entity db (:uid session))] 96 | (ui/page 97 | {} 98 | [:div "Signed in as " email ". " 99 | (biff/form 100 | {:action "/auth/signout" 101 | :class "inline"} 102 | [:button.text-blue-500.hover:text-blue-800 {:type "submit"} 103 | "Sign out"]) 104 | "."] 105 | [:.h-6] 106 | (biff/form 107 | {:action "/app/set-foo"} 108 | [:label.block {:for "foo"} "Foo: " 109 | [:span.font-mono (pr-str foo)]] 110 | [:.h-1] 111 | [:.flex 112 | [:input.w-full#foo {:type "text" :name "foo" :value foo}] 113 | [:.w-3] 114 | [:button.btn {:type "submit"} "Update"]] 115 | [:.h-1] 116 | [:.text-sm.text-gray-600 117 | "This demonstrates updating a value with a plain old form."]) 118 | [:.h-6] 119 | (bar-form {:value bar}) 120 | [:.h-6] 121 | (chat ctx)))) 122 | 123 | (defn ws-handler [{:keys [com.example/chat-clients] :as ctx}] 124 | {:status 101 125 | :headers {"upgrade" "websocket" 126 | "connection" "upgrade"} 127 | :ws {:on-connect (fn [ws] 128 | (swap! chat-clients conj ws)) 129 | :on-text (fn [ws text-message] 130 | (send-message ctx {:ws ws :text text-message})) 131 | :on-close (fn [ws status-code reason] 132 | (swap! chat-clients disj ws))}}) 133 | 134 | (def about-page 135 | (ui/page 136 | {:base/title (str "About " settings/app-name)} 137 | [:p "This app was made with " 138 | [:a.link {:href "https://biffweb.com"} "Biff"] "."])) 139 | 140 | (defn echo [{:keys [params]}] 141 | {:status 200 142 | :headers {"content-type" "application/json"} 143 | :body params}) 144 | 145 | (def module 146 | {:static {"/about/" about-page} 147 | :routes ["/app" {:middleware [mid/wrap-signed-in]} 148 | ["" {:get app}] 149 | ["/set-foo" {:post set-foo}] 150 | ["/set-bar" {:post set-bar}] 151 | ["/chat" {:get ws-handler}]] 152 | :api-routes [["/api/echo" {:post echo}]] 153 | :on-tx notify-clients}) 154 | -------------------------------------------------------------------------------- /starter/src/com/example/email.clj: -------------------------------------------------------------------------------- 1 | (ns com.example.email 2 | (:require [camel-snake-kebab.core :as csk] 3 | [camel-snake-kebab.extras :as cske] 4 | [clj-http.client :as http] 5 | [com.example.settings :as settings] 6 | [clojure.tools.logging :as log] 7 | [rum.core :as rum])) 8 | 9 | (defn signin-link [{:keys [to url user-exists]}] 10 | (let [[subject action] (if user-exists 11 | [(str "Sign in to " settings/app-name) "sign in"] 12 | [(str "Sign up for " settings/app-name) "sign up"])] 13 | {:to [{:email to}] 14 | :subject subject 15 | :html (rum/render-static-markup 16 | [:html 17 | [:body 18 | [:p "We received a request to " action " to " settings/app-name 19 | " using this email address. Click this link to " action ":"] 20 | [:p [:a {:href url :target "_blank"} "Click here to " action "."]] 21 | [:p "This link will expire in one hour. " 22 | "If you did not request this link, you can ignore this email."]]]) 23 | :text (str "We received a request to " action " to " settings/app-name 24 | " using this email address. Click this link to " action ":\n" 25 | "\n" 26 | url "\n" 27 | "\n" 28 | "This link will expire in one hour. If you did not request this link, " 29 | "you can ignore this email.")})) 30 | 31 | (defn signin-code [{:keys [to code user-exists]}] 32 | (let [[subject action] (if user-exists 33 | [(str "Sign in to " settings/app-name) "sign in"] 34 | [(str "Sign up for " settings/app-name) "sign up"])] 35 | {:to [{:email to}] 36 | :subject subject 37 | :html (rum/render-static-markup 38 | [:html 39 | [:body 40 | [:p "We received a request to " action " to " settings/app-name 41 | " using this email address. Enter the following code to " action ":"] 42 | [:p {:style {:font-size "2rem"}} code] 43 | [:p 44 | "This code will expire in three minutes. " 45 | "If you did not request this code, you can ignore this email."]]]) 46 | :text (str "We received a request to " action " to " settings/app-name 47 | " using this email address. Enter the following code to " action ":\n" 48 | "\n" 49 | code "\n" 50 | "\n" 51 | "This code will expire in three minutes. If you did not request this code, " 52 | "you can ignore this email.")})) 53 | 54 | (defn template [k opts] 55 | ((case k 56 | :signin-link signin-link 57 | :signin-code signin-code) 58 | opts)) 59 | 60 | (defn send-mailersend [{:keys [biff/secret mailersend/from mailersend/reply-to]} form-params] 61 | (let [result (http/post "https://api.mailersend.com/v1/email" 62 | {:oauth-token (secret :mailersend/api-key) 63 | :content-type :json 64 | :throw-exceptions false 65 | :as :json 66 | :form-params (merge {:from {:email from :name settings/app-name} 67 | :reply_to {:email reply-to :name settings/app-name}} 68 | form-params)}) 69 | success (< (:status result) 400)] 70 | (when-not success 71 | (log/error (:body result))) 72 | success)) 73 | 74 | (defn send-console [ctx form-params] 75 | (println "TO:" (:to form-params)) 76 | (println "SUBJECT:" (:subject form-params)) 77 | (println) 78 | (println (:text form-params)) 79 | (println) 80 | (println "To send emails instead of printing them to the console, add your" 81 | "API keys for MailerSend and Recaptcha to config.env.") 82 | true) 83 | 84 | (defn send-email [{:keys [biff/secret recaptcha/site-key] :as ctx} opts] 85 | (let [form-params (if-some [template-key (:template opts)] 86 | (template template-key opts) 87 | opts)] 88 | (if (every? some? [(secret :mailersend/api-key) 89 | (secret :recaptcha/secret-key) 90 | site-key]) 91 | (send-mailersend ctx form-params) 92 | (send-console ctx form-params)))) 93 | -------------------------------------------------------------------------------- /starter/src/com/example/home.clj: -------------------------------------------------------------------------------- 1 | (ns com.example.home 2 | (:require [clj-http.client :as http] 3 | [com.biffweb :as biff] 4 | [com.example.middleware :as mid] 5 | [com.example.ui :as ui] 6 | [com.example.settings :as settings] 7 | [rum.core :as rum] 8 | [xtdb.api :as xt])) 9 | 10 | (def email-disabled-notice 11 | [:.text-sm.mt-3.bg-blue-100.rounded.p-2 12 | "Until you add API keys for MailerSend and reCAPTCHA, we'll print your sign-up " 13 | "link to the console. See config.edn."]) 14 | 15 | (defn home-page [{:keys [recaptcha/site-key params] :as ctx}] 16 | (ui/page 17 | (assoc ctx ::ui/recaptcha true) 18 | (biff/form 19 | {:action "/auth/send-link" 20 | :id "signup" 21 | :hidden {:on-error "/"}} 22 | (biff/recaptcha-callback "submitSignup" "signup") 23 | [:h2.text-2xl.font-bold (str "Sign up for " settings/app-name)] 24 | [:.h-3] 25 | [:.flex 26 | [:input#email {:name "email" 27 | :type "email" 28 | :autocomplete "email" 29 | :placeholder "Enter your email address"}] 30 | [:.w-3] 31 | [:button.btn.g-recaptcha 32 | (merge (when site-key 33 | {:data-sitekey site-key 34 | :data-callback "submitSignup"}) 35 | {:type "submit"}) 36 | "Sign up"]] 37 | (when-some [error (:error params)] 38 | [:<> 39 | [:.h-1] 40 | [:.text-sm.text-red-600 41 | (case error 42 | "recaptcha" (str "You failed the recaptcha test. Try again, " 43 | "and make sure you aren't blocking scripts from Google.") 44 | "invalid-email" "Invalid email. Try again with a different address." 45 | "send-failed" (str "We weren't able to send an email to that address. " 46 | "If the problem persists, try another address.") 47 | "There was an error.")]]) 48 | [:.h-1] 49 | [:.text-sm "Already have an account? " [:a.link {:href "/signin"} "Sign in"] "."] 50 | [:.h-3] 51 | biff/recaptcha-disclosure 52 | email-disabled-notice))) 53 | 54 | (defn link-sent [{:keys [params] :as ctx}] 55 | (ui/page 56 | ctx 57 | [:h2.text-xl.font-bold "Check your inbox"] 58 | [:p "We've sent a sign-in link to " [:span.font-bold (:email params)] "."])) 59 | 60 | (defn verify-email-page [{:keys [params] :as ctx}] 61 | (ui/page 62 | ctx 63 | [:h2.text-2xl.font-bold (str "Sign up for " settings/app-name)] 64 | [:.h-3] 65 | (biff/form 66 | {:action "/auth/verify-link" 67 | :hidden {:token (:token params)}} 68 | [:div [:label {:for "email"} 69 | "It looks like you opened this link on a different device or browser than the one " 70 | "you signed up on. For verification, please enter the email you signed up with:"]] 71 | [:.h-3] 72 | [:.flex 73 | [:input#email {:name "email" :type "email" 74 | :placeholder "Enter your email address"}] 75 | [:.w-3] 76 | [:button.btn {:type "submit"} 77 | "Sign in"]]) 78 | (when-some [error (:error params)] 79 | [:<> 80 | [:.h-1] 81 | [:.text-sm.text-red-600 82 | (case error 83 | "incorrect-email" "Incorrect email address. Try again." 84 | "There was an error.")]]))) 85 | 86 | (defn signin-page [{:keys [recaptcha/site-key params] :as ctx}] 87 | (ui/page 88 | (assoc ctx ::ui/recaptcha true) 89 | (biff/form 90 | {:action "/auth/send-code" 91 | :id "signin" 92 | :hidden {:on-error "/signin"}} 93 | (biff/recaptcha-callback "submitSignin" "signin") 94 | [:h2.text-2xl.font-bold "Sign in to " settings/app-name] 95 | [:.h-3] 96 | [:.flex 97 | [:input#email {:name "email" 98 | :type "email" 99 | :autocomplete "email" 100 | :placeholder "Enter your email address"}] 101 | [:.w-3] 102 | [:button.btn.g-recaptcha 103 | (merge (when site-key 104 | {:data-sitekey site-key 105 | :data-callback "submitSignin"}) 106 | {:type "submit"}) 107 | "Sign in"]] 108 | (when-some [error (:error params)] 109 | [:<> 110 | [:.h-1] 111 | [:.text-sm.text-red-600 112 | (case error 113 | "recaptcha" (str "You failed the recaptcha test. Try again, " 114 | "and make sure you aren't blocking scripts from Google.") 115 | "invalid-email" "Invalid email. Try again with a different address." 116 | "send-failed" (str "We weren't able to send an email to that address. " 117 | "If the problem persists, try another address.") 118 | "invalid-link" "Invalid or expired link. Sign in to get a new link." 119 | "not-signed-in" "You must be signed in to view that page." 120 | "There was an error.")]]) 121 | [:.h-1] 122 | [:.text-sm "Don't have an account yet? " [:a.link {:href "/"} "Sign up"] "."] 123 | [:.h-3] 124 | biff/recaptcha-disclosure 125 | email-disabled-notice))) 126 | 127 | (defn enter-code-page [{:keys [recaptcha/site-key params] :as ctx}] 128 | (ui/page 129 | (assoc ctx ::ui/recaptcha true) 130 | (biff/form 131 | {:action "/auth/verify-code" 132 | :id "code-form" 133 | :hidden {:email (:email params)}} 134 | (biff/recaptcha-callback "submitCode" "code-form") 135 | [:div [:label {:for "code"} "Enter the 6-digit code that we sent to " 136 | [:span.font-bold (:email params)]]] 137 | [:.h-1] 138 | [:.flex 139 | [:input#code {:name "code" :type "text"}] 140 | [:.w-3] 141 | [:button.btn.g-recaptcha 142 | (merge (when site-key 143 | {:data-sitekey site-key 144 | :data-callback "submitCode"}) 145 | {:type "submit"}) 146 | "Sign in"]]) 147 | (when-some [error (:error params)] 148 | [:<> 149 | [:.h-1] 150 | [:.text-sm.text-red-600 151 | (case error 152 | "invalid-code" "Invalid code." 153 | "There was an error.")]]) 154 | [:.h-3] 155 | (biff/form 156 | {:action "/auth/send-code" 157 | :id "signin" 158 | :hidden {:email (:email params) 159 | :on-error "/signin"}} 160 | (biff/recaptcha-callback "submitSignin" "signin") 161 | [:button.link.g-recaptcha 162 | (merge (when site-key 163 | {:data-sitekey site-key 164 | :data-callback "submitSignin"}) 165 | {:type "submit"}) 166 | "Send another code"]))) 167 | 168 | (def module 169 | {:routes [["" {:middleware [mid/wrap-redirect-signed-in]} 170 | ["/" {:get home-page}]] 171 | ["/link-sent" {:get link-sent}] 172 | ["/verify-link" {:get verify-email-page}] 173 | ["/signin" {:get signin-page}] 174 | ["/verify-code" {:get enter-code-page}]]}) 175 | -------------------------------------------------------------------------------- /starter/src/com/example/middleware.clj: -------------------------------------------------------------------------------- 1 | (ns com.example.middleware 2 | (:require [com.biffweb :as biff] 3 | [muuntaja.middleware :as muuntaja] 4 | [ring.middleware.anti-forgery :as csrf] 5 | [ring.middleware.defaults :as rd])) 6 | 7 | (defn wrap-redirect-signed-in [handler] 8 | (fn [{:keys [session] :as ctx}] 9 | (if (some? (:uid session)) 10 | {:status 303 11 | :headers {"location" "/app"}} 12 | (handler ctx)))) 13 | 14 | (defn wrap-signed-in [handler] 15 | (fn [{:keys [session] :as ctx}] 16 | (if (some? (:uid session)) 17 | (handler ctx) 18 | {:status 303 19 | :headers {"location" "/signin?error=not-signed-in"}}))) 20 | 21 | ;; Stick this function somewhere in your middleware stack below if you want to 22 | ;; inspect what things look like before/after certain middleware fns run. 23 | (defn wrap-debug [handler] 24 | (fn [ctx] 25 | (let [response (handler ctx)] 26 | (println "REQUEST") 27 | (biff/pprint ctx) 28 | (def ctx* ctx) 29 | (println "RESPONSE") 30 | (biff/pprint response) 31 | (def response* response) 32 | response))) 33 | 34 | (defn wrap-site-defaults [handler] 35 | (-> handler 36 | biff/wrap-render-rum 37 | biff/wrap-anti-forgery-websockets 38 | csrf/wrap-anti-forgery 39 | biff/wrap-session 40 | muuntaja/wrap-params 41 | muuntaja/wrap-format 42 | (rd/wrap-defaults (-> rd/site-defaults 43 | (assoc-in [:security :anti-forgery] false) 44 | (assoc-in [:responses :absolute-redirects] true) 45 | (assoc :session false) 46 | (assoc :static false))))) 47 | 48 | (defn wrap-api-defaults [handler] 49 | (-> handler 50 | muuntaja/wrap-params 51 | muuntaja/wrap-format 52 | (rd/wrap-defaults rd/api-defaults))) 53 | 54 | (defn wrap-base-defaults [handler] 55 | (-> handler 56 | biff/wrap-https-scheme 57 | biff/wrap-resource 58 | biff/wrap-internal-error 59 | biff/wrap-ssl 60 | biff/wrap-log-requests)) 61 | -------------------------------------------------------------------------------- /starter/src/com/example/schema.clj: -------------------------------------------------------------------------------- 1 | (ns com.example.schema) 2 | 3 | (def schema 4 | {:user/id :uuid 5 | :user [:map {:closed true} 6 | [:xt/id :user/id] 7 | [:user/email :string] 8 | [:user/joined-at inst?] 9 | [:user/foo {:optional true} :string] 10 | [:user/bar {:optional true} :string]] 11 | 12 | :msg/id :uuid 13 | :msg [:map {:closed true} 14 | [:xt/id :msg/id] 15 | [:msg/user :user/id] 16 | [:msg/text :string] 17 | [:msg/sent-at inst?]]}) 18 | 19 | (def module 20 | {:schema schema}) 21 | -------------------------------------------------------------------------------- /starter/src/com/example/settings.clj: -------------------------------------------------------------------------------- 1 | (ns com.example.settings) 2 | 3 | (def app-name "My Application") 4 | -------------------------------------------------------------------------------- /starter/src/com/example/ui.clj: -------------------------------------------------------------------------------- 1 | (ns com.example.ui 2 | (:require [cheshire.core :as cheshire] 3 | [clojure.java.io :as io] 4 | [com.example.settings :as settings] 5 | [com.biffweb :as biff] 6 | [ring.middleware.anti-forgery :as csrf] 7 | [ring.util.response :as ring-response] 8 | [rum.core :as rum])) 9 | 10 | (defn static-path [path] 11 | (if-some [last-modified (some-> (io/resource (str "public" path)) 12 | ring-response/resource-data 13 | :last-modified 14 | (.getTime))] 15 | (str path "?t=" last-modified) 16 | path)) 17 | 18 | (defn base [{:keys [::recaptcha] :as ctx} & body] 19 | (apply 20 | biff/base-html 21 | (-> ctx 22 | (merge #:base{:title settings/app-name 23 | :lang "en-US" 24 | :icon "/img/glider.png" 25 | :description (str settings/app-name " Description") 26 | :image "https://clojure.org/images/clojure-logo-120b.png"}) 27 | (update :base/head (fn [head] 28 | (concat [[:link {:rel "stylesheet" :href (static-path "/css/main.css")}] 29 | [:script {:src (static-path "/js/main.js")}] 30 | [:script {:src "https://unpkg.com/htmx.org@2.0.4"}] 31 | [:script {:src "https://unpkg.com/htmx-ext-ws@2.0.1/ws.js"}] 32 | [:script {:src "https://unpkg.com/hyperscript.org@0.9.13"}] 33 | (when recaptcha 34 | [:script {:src "https://www.google.com/recaptcha/api.js" 35 | :async "async" :defer "defer"}])] 36 | head)))) 37 | body)) 38 | 39 | (defn page [ctx & body] 40 | (base 41 | ctx 42 | [:.flex-grow] 43 | [:.p-3.mx-auto.max-w-screen-sm.w-full 44 | (when (bound? #'csrf/*anti-forgery-token*) 45 | {:hx-headers (cheshire/generate-string 46 | {:x-csrf-token csrf/*anti-forgery-token*})}) 47 | body] 48 | [:.flex-grow] 49 | [:.flex-grow])) 50 | 51 | (defn on-error [{:keys [status ex] :as ctx}] 52 | {:status status 53 | :headers {"content-type" "text/html"} 54 | :body (rum/render-static-markup 55 | (page 56 | ctx 57 | [:h1.text-lg.font-bold 58 | (if (= status 404) 59 | "Page not found." 60 | "Something went wrong.")]))}) 61 | -------------------------------------------------------------------------------- /starter/src/com/example/worker.clj: -------------------------------------------------------------------------------- 1 | (ns com.example.worker 2 | (:require [clojure.tools.logging :as log] 3 | [com.biffweb :as biff :refer [q]] 4 | [xtdb.api :as xt])) 5 | 6 | (defn every-n-minutes [n] 7 | (iterate #(biff/add-seconds % (* 60 n)) (java.util.Date.))) 8 | 9 | (defn print-usage [{:keys [biff/db]}] 10 | ;; For a real app, you can have this run once per day and send you the output 11 | ;; in an email. 12 | (let [n-users (nth (q db 13 | '{:find (count user) 14 | :where [[user :user/email]]}) 15 | 0 16 | 0)] 17 | (log/info "There are" n-users "users."))) 18 | 19 | (defn alert-new-user [{:keys [biff.xtdb/node]} tx] 20 | (doseq [_ [nil] 21 | :let [db-before (xt/db node {::xt/tx-id (dec (::xt/tx-id tx))})] 22 | [op & args] (::xt/tx-ops tx) 23 | :when (= op ::xt/put) 24 | :let [[doc] args] 25 | :when (and (contains? doc :user/email) 26 | (nil? (xt/entity db-before (:xt/id doc))))] 27 | ;; You could send this as an email instead of printing. 28 | (log/info "WOAH there's a new user"))) 29 | 30 | (defn echo-consumer [{:keys [biff/job] :as ctx}] 31 | (prn :echo job) 32 | (when-some [callback (:biff/callback job)] 33 | (callback job))) 34 | 35 | (def module 36 | {:tasks [{:task #'print-usage 37 | :schedule #(every-n-minutes 5)}] 38 | :on-tx alert-new-user 39 | :queues [{:id :echo 40 | :consumer #'echo-consumer}]}) 41 | -------------------------------------------------------------------------------- /starter/test/com/example_test.clj: -------------------------------------------------------------------------------- 1 | (ns com.example-test 2 | (:require [cheshire.core :as cheshire] 3 | [clojure.string :as str] 4 | [clojure.test :refer [deftest is]] 5 | [com.biffweb :as biff :refer [test-xtdb-node]] 6 | [com.example :as main] 7 | [com.example.app :as app] 8 | [malli.generator :as mg] 9 | [rum.core :as rum] 10 | [xtdb.api :as xt])) 11 | 12 | (deftest example-test 13 | (is (= 4 (+ 2 2)))) 14 | 15 | (defn get-context [node] 16 | {:biff.xtdb/node node 17 | :biff/db (xt/db node) 18 | :biff/malli-opts #'main/malli-opts}) 19 | 20 | (deftest send-message-test 21 | (with-open [node (test-xtdb-node [])] 22 | (let [message (mg/generate :string) 23 | user (mg/generate :user main/malli-opts) 24 | ctx (assoc (get-context node) :session {:uid (:xt/id user)}) 25 | _ (app/send-message ctx {:text (cheshire/generate-string {:text message})}) 26 | db (xt/db node) ; get a fresh db value so it contains any transactions 27 | ; that send-message submitted. 28 | doc (biff/lookup db :msg/text message)] 29 | (is (some? doc)) 30 | (is (= (:msg/user doc) (:xt/id user)))))) 31 | 32 | (deftest chat-test 33 | (let [n-messages (+ 3 (rand-int 10)) 34 | now (java.util.Date.) 35 | messages (for [doc (mg/sample :msg (assoc main/malli-opts :size n-messages))] 36 | (assoc doc :msg/sent-at now))] 37 | (with-open [node (test-xtdb-node messages)] 38 | (let [response (app/chat {:biff/db (xt/db node)}) 39 | html (rum/render-html response)] 40 | (is (str/includes? html "Messages sent in the past 10 minutes:")) 41 | (is (not (str/includes? html "No messages yet."))) 42 | ;; If you add Jsoup to your dependencies, you can use DOM selectors instead of just regexes: 43 | ;(is (= n-messages (count (.select (Jsoup/parse html) "#messages > *")))) 44 | (is (= n-messages (count (re-seq #"init send newMessage to #message-header" html)))) 45 | (is (every? #(str/includes? html (:msg/text %)) messages)))))) 46 | -------------------------------------------------------------------------------- /tasks/deps.edn: -------------------------------------------------------------------------------- 1 | {:paths ["src"]} 2 | -------------------------------------------------------------------------------- /tasks/src/com/biffweb/tasks.clj: -------------------------------------------------------------------------------- 1 | ;; This file is deprecated and should not be modified except for bug fixes. It was used by default 2 | ;; previously when Biff used Babashka tasks. Now we use plain clj for tasks by default instead, and 3 | ;; this file remains only for backwards compatibility. See libs/tasks/src/com/biffweb/tasks.clj for 4 | ;; the current task implementations. 5 | (ns com.biffweb.tasks 6 | (:require [babashka.curl :as curl] 7 | [babashka.fs :as fs] 8 | [babashka.process :as process] 9 | [babashka.tasks :as tasks :refer [clojure]] 10 | [clojure.edn :as edn] 11 | [clojure.java.io :as io] 12 | [clojure.java.shell :as sh] 13 | [clojure.string :as str] 14 | [clojure.stacktrace :as st])) 15 | 16 | (def config 17 | (delay (:tasks (edn/read-string (slurp "config.edn"))))) 18 | 19 | (def ^:dynamic *shell-env* nil) 20 | 21 | (defn windows? [] 22 | (-> (System/getProperty "os.name") 23 | (str/lower-case) 24 | (str/includes? "windows"))) 25 | 26 | (defn shell [& args] 27 | (apply tasks/shell {:extra-env *shell-env*} args)) 28 | 29 | (defn get-env-from [cmd] 30 | (let [{:keys [exit out]} (sh/sh "sh" "-c" (str cmd "; printenv"))] 31 | (when (= 0 exit) 32 | (->> out 33 | str/split-lines 34 | (map #(vec (str/split % #"=" 2))) 35 | (filter #(= 2 (count %))) 36 | (into {}))))) 37 | 38 | (defn sh-success? [& args] 39 | (try 40 | (= 0 (:exit (apply sh/sh args))) 41 | (catch Exception _ 42 | false))) 43 | 44 | (defn with-ssh-agent* [f] 45 | (if-let [env (and (not (:biff.tasks/skip-ssh-agent @config)) 46 | (fs/which "ssh-agent") 47 | (not (sh-success? "ssh-add" "-l")) 48 | (nil? *shell-env*) 49 | (if (windows?) 50 | {} 51 | (get-env-from "eval $(ssh-agent)")))] 52 | (binding [*shell-env* env] 53 | (try 54 | (try 55 | (shell "ssh-add") 56 | (println "Started an ssh-agent session. If you set up `keychain`, you won't have to enter your password" 57 | "each time you run this command: https://www.funtoo.org/Funtoo:Keychain") 58 | (catch Exception e 59 | (binding [*out* *err*] 60 | (st/print-throwable e) 61 | (println "\nssh-add failed. You may have to enter your password multiple times. You can avoid this if you set up `keychain`:" 62 | "https://www.funtoo.org/Funtoo:Keychain")))) 63 | (f) 64 | (finally 65 | (sh/sh "ssh-agent" "-k" :env *shell-env*)))) 66 | (f))) 67 | 68 | (defmacro with-ssh-agent [& body] 69 | `(with-ssh-agent* (fn [] ~@body))) 70 | 71 | (defmacro future-verbose [& body] 72 | `(future 73 | (try 74 | ~@body 75 | (catch Exception e# 76 | ;; st/print-stack-trace just prints Babashka's internal stack trace. 77 | (st/print-throwable e#) 78 | (println))))) 79 | 80 | (defn new-secret [length] 81 | (let [buffer (byte-array length)] 82 | (.nextBytes (java.security.SecureRandom/getInstanceStrong) buffer) 83 | (.encodeToString (java.util.Base64/getEncoder) buffer))) 84 | 85 | (defn generate-secrets 86 | "Prints new values to put in secrets.env." 87 | [] 88 | (println "Put these in your secrets.env file:") 89 | (println) 90 | (println (str "export COOKIE_SECRET=" (new-secret 16))) 91 | (println (str "export JWT_SECRET=" (new-secret 32))) 92 | (println)) 93 | 94 | (defn server [& args] 95 | (apply shell "ssh" (str "root@" (:biff.tasks/server @config)) args)) 96 | 97 | (defn trench [& args] 98 | (apply server "trench" "-p" "7888" "-e" args)) 99 | 100 | (defn local-tailwind-path [] 101 | (if (windows?) 102 | "bin/tailwindcss.exe" 103 | "bin/tailwindcss")) 104 | 105 | (defn tailwind-file [] 106 | (let [os-name (str/lower-case (System/getProperty "os.name")) 107 | os-type (cond 108 | (str/includes? os-name "windows") "windows" 109 | (str/includes? os-name "linux") "linux" 110 | :else "macos") 111 | arch (case (System/getProperty "os.arch") 112 | "amd64" "x64" 113 | "arm64")] 114 | (str "tailwindcss-" os-type "-" arch (when (= os-type "windows") ".exe")))) 115 | 116 | (defn install-tailwind [] 117 | (let [file (cond 118 | (:biff.tasks/tailwind-file @config) 119 | (:biff.tasks/tailwind-file @config) 120 | 121 | ;; Backwards compatibility. 122 | (:biff.tasks/tailwind-build @config) 123 | (str "tailwindcss-" (:biff.tasks/tailwind-build @config)) 124 | 125 | :else 126 | (tailwind-file)) 127 | url (str "https://github.com/tailwindlabs/tailwindcss/releases/latest/download/" 128 | file) 129 | dest (io/file (local-tailwind-path))] 130 | (io/make-parents dest) 131 | (println "Downloading the latest version of Tailwind CSS...") 132 | (println (str "Auto-detected build: " file ". If that's incorrect, set :biff.tasks/tailwind-file in config.edn.")) 133 | (println) 134 | (println "After the download finishes, you can avoid downloading Tailwind again for" 135 | "future projects if you copy it to your path, e.g. by running:") 136 | (println " sudo cp" (local-tailwind-path) "/usr/local/bin/tailwindcss") 137 | (println) 138 | (io/copy (:body (curl/get url {:compressed false :as :stream})) dest) 139 | (.setExecutable dest true))) 140 | 141 | (def css-output "target/resources/public/css/main.css") 142 | 143 | (defn css 144 | "Generates the target/resources/public/css/main.css file. 145 | 146 | The logic for running and installing Tailwind is: 147 | 148 | 1. If tailwindcss has been installed via npm, then `npx tailwindcss` will be 149 | used. 150 | 151 | 2. Otherwise, if the tailwindcss standalone binary has been downloaded to 152 | ./bin/, that will be used. 153 | 154 | 3. Otherwise, if the tailwindcss standalone binary has been installed to the 155 | path (e.g. /usr/local/bin/tailwindcss), that will be used. 156 | 157 | 4. Otherwise, the tailwindcss standalone binary will be downloaded to ./bin/, 158 | and that will be used." 159 | [& args] 160 | (let [local-bin-installed (fs/exists? (local-tailwind-path)) 161 | tailwind-cmd (cond 162 | (sh-success? "npm" "list" "tailwindcss") :npm 163 | (and (fs/which "tailwindcss") 164 | (not local-bin-installed)) :global-bin 165 | :else :local-bin)] 166 | (when (and (= tailwind-cmd :local-bin) (not local-bin-installed)) 167 | (install-tailwind)) 168 | (when (= tailwind-cmd :local-bin) 169 | ;; This normally will be handled by install-tailwind, but we set it here 170 | ;; in case that function was interrupted. Assuming the download was 171 | ;; incomplete, the 139 exit code handler will be triggered below. 172 | (.setExecutable (io/file (local-tailwind-path)) true)) 173 | (try 174 | (apply shell (concat (case tailwind-cmd 175 | :npm ["npx" "tailwindcss"] 176 | :global-bin [(str (fs/which "tailwindcss"))] 177 | :local-bin [(local-tailwind-path)]) 178 | ["-c" "resources/tailwind.config.js" 179 | "-i" "resources/tailwind.css" 180 | "-o" css-output] 181 | args)) 182 | (catch Exception e 183 | (when (and (= 139 (:babashka/exit (ex-data e))) 184 | (#{:local-bin :global-bin} tailwind-cmd)) 185 | (binding [*out* *err*] 186 | (println "It looks like your Tailwind installation is corrupted. Try deleting it and running this command again:") 187 | (println) 188 | (println " rm" (if (= tailwind-cmd :local-bin) 189 | (local-tailwind-path) 190 | (str (fs/which "tailwindcss")))) 191 | (println))) 192 | (throw e))))) 193 | 194 | (defn run-args [] 195 | (:biff.tasks/clj-args 196 | @config 197 | ;; For backwards compatibility 198 | ["-J-XX:-OmitStackTraceInFastThrow" 199 | "-M" "-m" (:biff.tasks/main-ns @config) 200 | "--port" "7888" 201 | "--middleware" "[cider.nrepl/cider-middleware,refactor-nrepl.middleware/wrap-refactor]"])) 202 | 203 | ;; Algorithm copied from Python's shlex.quote() 204 | ;; https://github.com/python/cpython/blob/db65a326a4022fbd43648858b460f52734faf1b5/Lib/shlex.py#L325 205 | (defn shell-escape [s] 206 | (str \' 207 | (some-> s (str/replace "'" "'\"'\"'")) 208 | \')) 209 | 210 | (defn run-cmd 211 | "Internal. Used by the server to start the app." 212 | [] 213 | (let [commands (filter some? 214 | ["mkdir -p target/resources" 215 | (when (fs/exists? "package.json") 216 | "npm install") 217 | "set -a" 218 | (when (fs/exists? "secrets.env") 219 | ". ./secrets.env") 220 | (when (fs/exists? "config.env") 221 | ". ./config.env") 222 | (->> (run-args) 223 | (map shell-escape) 224 | (str/join " ") 225 | (str "clj "))])] 226 | (println "eval" (str/join " ; " commands)))) 227 | 228 | ;; Algorithm adapted from dotenv-java: 229 | ;; https://github.com/cdimascio/dotenv-java/blob/master/src/main/java/io/github/cdimascio/dotenv/internal/DotenvParser.java 230 | ;; Wouldn't hurt to take a more thorough look at Ruby dotenv's algorithm: 231 | ;; https://github.com/bkeepers/dotenv/blob/master/lib/dotenv/parser.rb 232 | (defn parse-env-var [line] 233 | (let [line (str/trim line) 234 | [_ _ k v] (re-matches #"^\s*(export\s+)?([\w.\-]+)\s*=\s*(['][^']*[']|[\"][^\"]*[\"]|[^#]*)?\s*(#.*)?$" 235 | line)] 236 | (when-not (or (str/starts-with? line "#") 237 | (str/starts-with? line "////") 238 | (empty? v)) 239 | (let [v (str/trim v) 240 | v (if (or (re-matches #"^\".*\"$" v) 241 | (re-matches #"^'.*'$" v)) 242 | (subs v 1 (dec (count v))) 243 | v)] 244 | [k v])))) 245 | 246 | (comment 247 | [(parse-env-var "FOO=BAR") 248 | (parse-env-var "FOO='BAR'") 249 | (parse-env-var "FOO=\"BAR\"") 250 | (parse-env-var "FOO=\"BAR\" # hello") 251 | (parse-env-var " export FOO=\"BAR\" # hello") 252 | (parse-env-var "# FOO=\"BAR\"") 253 | (parse-env-var " ")]) 254 | 255 | (defn secrets [] 256 | (let [config-file (first (filter fs/exists? ["config.env" "secrets.env"]))] 257 | (cond 258 | (nil? config-file) 259 | nil 260 | 261 | (and (not (windows?)) 262 | ;; Backwards compatibility--just in case someone was relying on fancy behavior in secrets.env. Problem with 263 | ;; doing this for config.env is it doesn't work if you don't have `export` on every line. 264 | (= config-file "secrets.env")) 265 | (get-env-from (str ". ./" config-file)) 266 | 267 | :else 268 | (->> (slurp config-file) 269 | str/split-lines 270 | (keep parse-env-var) 271 | (into {}))))) 272 | 273 | (defn dev 274 | "Starts the app locally. 275 | 276 | After running, wait for the `System started` message. Connect your editor to 277 | nrepl port 7888. Whenever you save a file, Biff will: 278 | 279 | - Evaluate any changed Clojure files 280 | - Regenerate static HTML and CSS files 281 | - Run tests" 282 | [& args] 283 | (io/make-parents "target/resources/_") 284 | (when (fs/exists? "package.json") 285 | (shell "npm" "install")) 286 | (future-verbose (css "--watch")) 287 | (spit ".nrepl-port" "7888") 288 | (apply clojure {:extra-env (merge (secrets) {"BIFF_ENV" "dev"})} 289 | (concat args (run-args)))) 290 | 291 | (defn format 292 | "Formats the code with cljfmt." 293 | [] 294 | (clojure 295 | "-Sdeps" (pr-str '{:deps {cljfmt/cljfmt {:mvn/version "0.8.2"}}}) 296 | "-M" "-m" "cljfmt.main" "fix" "--indents" "cljfmt-indents.edn")) 297 | 298 | (defn clean 299 | "Deletes generated files." 300 | [] 301 | (fs/delete-tree "target")) 302 | 303 | (defn post-receive 304 | "Deprecated." 305 | [] 306 | nil) 307 | 308 | (defn refresh 309 | "Reloads code and restarts the system via `clojure.tools.namespace.repl/refresh` (on the server)." 310 | [] 311 | (binding [*out* *err*] 312 | (println "This command has been removed. Instead, you can connect your editor to the server with" 313 | "`bb prod-dev` or `bb prod-repl`, then call the (refresh) function from your editor."))) 314 | 315 | (defn restart 316 | "Restarts the app process via `systemctl restart app` (on the server)." 317 | [] 318 | (server "systemctl reset-failed app.service; systemctl restart app")) 319 | 320 | (defn- push-files-rsync [] 321 | (let [{:biff.tasks/keys [server]} @config 322 | files (->> (:out (sh/sh "git" "ls-files")) 323 | str/split-lines 324 | (map #(str/replace % #"/.*" "")) 325 | distinct 326 | (concat ["config.edn" 327 | "secrets.env" 328 | "config.env" 329 | css-output]) 330 | (filter fs/exists?))] 331 | (when-not (windows?) 332 | (fs/set-posix-file-permissions "config.edn" "rw-------") 333 | (when (fs/exists? "secrets.env") 334 | (fs/set-posix-file-permissions "secrets.env" "rw-------")) 335 | (when (fs/exists? "config.env") 336 | (fs/set-posix-file-permissions "config.env" "rw-------")) 337 | ) 338 | (->> (concat ["rsync" "--archive" "--verbose" "--relative" "--include='**.gitignore'" 339 | "--exclude='/.git'" "--filter=:- .gitignore" "--delete-after" "--protocol=29"] 340 | files 341 | [(str "app@" server ":")]) 342 | (apply shell)))) 343 | 344 | (defn- push-files-git [] 345 | (let [{:biff.tasks/keys [server deploy-to deploy-from deploy-cmd]} @config] 346 | (apply shell (concat ["scp" "config.edn"] 347 | (when (fs/exists? "secrets.env") ["secrets.env"]) 348 | (when (fs/exists? "config.env") ["config.env"]) 349 | [(str "app@" server ":")])) 350 | (when (fs/exists? css-output) 351 | (shell "ssh" (str "app@" server) "mkdir" "-p" "target/resources/public/css/") 352 | (shell "scp" css-output (str "app@" server ":" css-output))) 353 | (time (if deploy-cmd 354 | (apply shell deploy-cmd) 355 | ;; For backwards compatibility 356 | (shell "git" "push" deploy-to deploy-from))))) 357 | 358 | (defn- push-files [] 359 | (if (fs/which "rsync") 360 | (push-files-rsync) 361 | (push-files-git))) 362 | 363 | (defn soft-deploy 364 | "Pushes code to the server and evaluates changed files. 365 | 366 | Uploads config and code to the server (see `deploy`), then `eval`s any 367 | changed files and regenerates HTML and CSS files. Does not refresh or 368 | restart." 369 | [] 370 | (with-ssh-agent 371 | (let [{:biff.tasks/keys [soft-deploy-fn on-soft-deploy]} @config] 372 | (css "--minify") 373 | (push-files) 374 | (trench (or on-soft-deploy 375 | ;; backwards compatibility 376 | (str "\"(" soft-deploy-fn " @com.biffweb/system)\"")))))) 377 | 378 | (defn deploy 379 | "Pushes code to the server and restarts the app. 380 | 381 | Uploads config (config.edn, secrets.env and/or config.env) and code to the server, using 382 | `rsync` if it's available, and `git push` by default otherwise. Then restarts 383 | the app. 384 | 385 | You must set up a server first. See https://biffweb.com/docs/reference/production/" 386 | [] 387 | (with-ssh-agent 388 | (css "--minify") 389 | (push-files) 390 | (restart))) 391 | 392 | (defn auto-soft-deploy [] 393 | (soft-deploy) 394 | (let [last-ran (atom (System/nanoTime)) 395 | p (process/process ["fswatch" "-orl" "0.1" "--event=Updated" "--event=Removed" "--allow-overflow" "."] 396 | {:err :inherit})] 397 | (with-open [rdr (io/reader (:out p))] 398 | (doseq [l (line-seq rdr)] 399 | (when (< (Math/pow 10 9) (- (System/nanoTime) @last-ran)) 400 | (soft-deploy)) 401 | (reset! last-ran (System/nanoTime)))))) 402 | 403 | (defn logs 404 | "Tails the server's application logs." 405 | [& [n-lines]] 406 | (server "journalctl" "-u" "app" "-f" "-n" (or n-lines "300"))) 407 | 408 | (defn prod-repl 409 | "Opens an SSH tunnel so you can connect to the server via nREPL." 410 | [] 411 | (println "Connect to nrepl port 7888") 412 | (spit ".nrepl-port" "7888") 413 | (shell "ssh" "-NL" "7888:localhost:7888" (str "root@" (:biff.tasks/server @config)))) 414 | 415 | (defn prod-dev 416 | "Runs the auto-soft-deploy command whenever a file is modified. Also runs prod-repl and logs." 417 | [] 418 | (when-not (fs/which "rsync") 419 | (binding [*out* *err*] 420 | (println "`rsync` command not found. Please install it.") 421 | (println "Alternatively, you can deploy without downtime by running `git add .; git commit; bb soft-deploy`")) 422 | (System/exit 1)) 423 | (when-not (fs/which "fswatch") 424 | (println "`fswatch` command not found. Please install it: https://emcrisostomo.github.io/fswatch/getting.html") 425 | (println " - Ubuntu: sudo apt install fswatch") 426 | (println " - Mac: brew install fswatch") 427 | (System/exit 2)) 428 | (with-ssh-agent 429 | (future-verbose (prod-repl)) 430 | (future-verbose (auto-soft-deploy)) 431 | (logs))) 432 | -------------------------------------------------------------------------------- /test/com/biffweb/impl/middleware_test.clj: -------------------------------------------------------------------------------- 1 | (ns com.biffweb.impl.middleware-test 2 | (:require [clojure.test :refer [deftest is]] 3 | [cheshire.core :as cheshire] 4 | [com.biffweb :as biff])) 5 | 6 | (def default-request 7 | {:request-method :get 8 | :uri "/" 9 | :scheme :https 10 | :headers {"host" "example.com"} 11 | :biff.middleware/cookie-secret (biff/generate-secret 16)}) 12 | 13 | (defn call-with-headers [handler ctx] 14 | (let [resp (handler (merge default-request ctx))] 15 | (cond-> resp 16 | (not (string? (:body resp))) (update :body slurp) 17 | true (dissoc :session)))) 18 | 19 | (defn string->stream 20 | ([s] (string->stream s "UTF-8")) 21 | ([s encoding] 22 | (-> s 23 | (.getBytes encoding) 24 | (java.io.ByteArrayInputStream.)))) 25 | 26 | (def param-handler 27 | (-> (fn [{:keys [params] :as ctx}] 28 | {:status 200 29 | :headers {"Content-Type" "text/plain"} 30 | :body (pr-str params)}) 31 | biff/wrap-site-defaults 32 | biff/wrap-base-defaults)) 33 | 34 | (defn constant-handler [response] 35 | (-> (constantly response) 36 | biff/wrap-site-defaults 37 | biff/wrap-base-defaults)) 38 | 39 | (defn call 40 | ([handler ctx] 41 | (let [ctx (cond-> ctx 42 | (:body ctx) (update :body string->stream)) 43 | resp (handler (merge default-request ctx))] 44 | (cond-> resp 45 | (not (string? (:body resp))) (update :body slurp) 46 | true (dissoc :session :headers)))) 47 | ([ctx] 48 | (call param-handler ctx))) 49 | 50 | (deftest middleware 51 | (is (= (call-with-headers param-handler {}) 52 | {:status 200, 53 | :headers 54 | {"Content-Type" "text/plain; charset=utf-8", 55 | "X-XSS-Protection" "1; mode=block", 56 | "X-Frame-Options" "SAMEORIGIN", 57 | "X-Content-Type-Options" "nosniff", 58 | "Strict-Transport-Security" "max-age=31536000; includeSubDomains"}, 59 | :body "{}"})) 60 | 61 | (is (= (call param-handler {:query-string "foo=bar"}) 62 | {:status 200, :body "{:foo \"bar\"}"})) 63 | 64 | (is (= (call param-handler {:method :post 65 | :headers {"content-type" "application/json"} 66 | :body (cheshire/generate-string {:baz "quux"})}) 67 | {:status 200, :body "{:baz \"quux\"}"})) 68 | 69 | (is (= (call param-handler {:method :post 70 | :headers {"content-type" "application/x-www-form-urlencoded"} 71 | :body "foo=bar"}) 72 | {:status 200, :body "{:foo \"bar\"}"})) 73 | 74 | (is (= (call (constant-handler {:status 200 75 | :headers {"Content-Type" "application/edn"} 76 | :body (pr-str {:foo :bar})}) 77 | {}) 78 | {:status 200, :body "{:foo :bar}"})) 79 | 80 | (is (= (call (constant-handler {:status 200 81 | :body {:foo :bar}}) 82 | {:headers {"accept" "application/edn"}}) 83 | {:status 200, :body "{:foo :bar}"}))) 84 | -------------------------------------------------------------------------------- /test/com/biffweb/impl/xtdb_test.clj: -------------------------------------------------------------------------------- 1 | (ns com.biffweb.impl.xtdb-test 2 | (:require [clojure.test :refer [deftest is]] 3 | [xtdb.api :as xt] 4 | [com.biffweb :as biff :refer [test-xtdb-node]] 5 | [malli.core :as malc] 6 | [malli.registry :as malr])) 7 | 8 | (def schema 9 | {:user/id :keyword 10 | :user/email :string 11 | :user/foo :string 12 | :user/bar :string 13 | :user [:map {:closed true} 14 | [:xt/id :user/id] 15 | :user/email 16 | [:user/foo {:optional true}] 17 | [:user/bar {:optional true}]] 18 | 19 | :msg/id :keyword 20 | :msg/user :user/id 21 | :msg/text :string 22 | :msg/sent-at inst? 23 | :msg [:map {:closed true} 24 | [:xt/id :msg/id] 25 | :msg/user 26 | :msg/text 27 | :msg/sent-at]}) 28 | 29 | (def malli-opts {:registry (malr/composite-registry malc/default-registry schema)}) 30 | 31 | (deftest ensure-unique 32 | (with-open [node (test-xtdb-node [{:foo "bar"}])] 33 | (let [db (xt/db node)] 34 | (is (nil? (xt/with-tx 35 | db 36 | [[::xt/put {:xt/id (random-uuid) 37 | :foo "bar"}] 38 | [::xt/fn :biff/ensure-unique {:foo "bar"}]]))) 39 | (is (some? (xt/with-tx 40 | db 41 | [[::xt/put {:xt/id (random-uuid) 42 | :foo "baz"}] 43 | [::xt/fn :biff/ensure-unique {:foo "bar"}]])))))) 44 | 45 | (deftest tx-upsert 46 | (with-open [node (test-xtdb-node [{:xt/id :id/foo 47 | :foo "bar"}])] 48 | (is (= (biff/tx-xform-upsert 49 | {:biff/db (xt/db node)} 50 | [{:db/doc-type :user 51 | :db.op/upsert {:foo "bar"} 52 | :baz "quux"}]) 53 | '({:db/doc-type :user, 54 | :baz "quux", 55 | :foo "bar", 56 | :db/op :merge, 57 | :xt/id :id/foo}))) 58 | (is (= (biff/tx-xform-upsert 59 | {:biff/db (xt/db node)} 60 | [{:db/doc-type :user 61 | :db.op/upsert {:foo "eh"} 62 | :baz "quux"}]) 63 | '({:db/doc-type :user, 64 | :baz "quux", 65 | :foo "eh", 66 | :db/op :merge} 67 | [:xtdb.api/fn :biff/ensure-unique {:foo "eh"}]))))) 68 | 69 | (deftest tx-unique 70 | (is (= (biff/tx-xform-unique 71 | nil 72 | [{:foo "bar" 73 | :baz [:db/unique "quux"] 74 | :spam [:db/unique "eggs"]} 75 | {:hello "there"}]) 76 | '({:foo "bar", :baz "quux", :spam "eggs"} 77 | [:xtdb.api/fn :biff/ensure-unique {:baz "quux"}] 78 | [:xtdb.api/fn :biff/ensure-unique {:spam "eggs"}] 79 | {:hello "there"})))) 80 | 81 | (deftest tx-tmp-ids 82 | (let [[{:keys [a b c]} 83 | {:keys [d]}] (biff/tx-xform-tmp-ids 84 | nil 85 | [{:a 1 86 | :b :db.id/foo 87 | :c :db.id/bar} 88 | {:d :db.id/foo}])] 89 | (is (every? uuid? [b c d])) 90 | (is (= b d)) 91 | (is (not= b c)))) 92 | 93 | (defn get-context [node] 94 | {:biff/db (xt/db node) 95 | :biff/now #inst "1970" 96 | :biff/malli-opts #'malli-opts}) 97 | 98 | (def test-docs [{:xt/id :user/alice 99 | :user/email "alice@example.com"} 100 | {:xt/id :user/bob 101 | :user/email "bob@example.com"}]) 102 | 103 | (deftest tx-default 104 | (with-open [node (test-xtdb-node (into test-docs 105 | [{:xt/id :user/carol 106 | :user/email "carol@example.com" 107 | :user/foo "x"}]))] 108 | (is (= (biff/biff-tx->xt 109 | (get-context node) 110 | [{:db/doc-type :user 111 | :db/op :update 112 | :xt/id :user/bob 113 | :user/foo [:db/default "default-value"]} 114 | {:db/doc-type :user 115 | :db/op :update 116 | :xt/id :user/carol 117 | :user/foo [:db/default "default-value"]}]) 118 | '([:xtdb.api/match 119 | :user/bob 120 | {:user/email "bob@example.com", :xt/id :user/bob}] 121 | [:xtdb.api/put 122 | {:user/email "bob@example.com", 123 | :xt/id :user/bob, 124 | :user/foo "default-value"}] 125 | [:xtdb.api/match 126 | :user/carol 127 | {:user/email "carol@example.com", :user/foo "x", :xt/id :user/carol}] 128 | [:xtdb.api/put 129 | {:user/email "carol@example.com", :user/foo "x", :xt/id :user/carol}]))))) 130 | 131 | (deftest tx-all 132 | (with-open [node (test-xtdb-node test-docs)] 133 | (is (= (biff/biff-tx->xt 134 | (get-context node) 135 | [{:db/doc-type :user 136 | :db.op/upsert {:user/email "alice@example.com"} 137 | :user/foo "bar"} 138 | {:db/doc-type :user 139 | :db/op :update 140 | :xt/id :user/bob 141 | :user/bar "baz"}]) 142 | '([:xtdb.api/match 143 | :user/alice 144 | {:user/email "alice@example.com", :xt/id :user/alice}] 145 | [:xtdb.api/put 146 | {:user/email "alice@example.com", 147 | :xt/id :user/alice, 148 | :user/foo "bar"}] 149 | [:xtdb.api/match 150 | :user/bob 151 | {:user/email "bob@example.com", :xt/id :user/bob}] 152 | [:xtdb.api/put 153 | {:user/email "bob@example.com", :xt/id :user/bob, :user/bar "baz"}]))))) 154 | 155 | (deftest lookup 156 | (with-open [node (test-xtdb-node [{:xt/id :user/alice 157 | :user/email "alice@example.com" 158 | :user/foo "foo"} 159 | {:xt/id :user/bob 160 | :user/email "bob@example.com" 161 | :user/foo "foo"} 162 | {:xt/id :user/carol 163 | :user/email "bob@example.com"} 164 | {:xt/id :msg/a 165 | :msg/user :user/alice 166 | :msg/text "hello" 167 | :msg/sent-at #inst "1970"} 168 | {:xt/id :msg/b 169 | :msg/user :user/alice 170 | :msg/text "there" 171 | :msg/sent-at #inst "1971"}])] 172 | (let [db (xt/db node)] 173 | (is (= :user/alice (biff/lookup-id db :user/email "alice@example.com"))) 174 | (is (= '(:user/alice :user/bob) (sort (biff/lookup-id-all db :user/foo "foo")))) 175 | (is (= {:user/email "alice@example.com", :user/foo "foo", :xt/id :user/alice} 176 | (biff/lookup db :user/email "alice@example.com"))) 177 | (is (= '({:user/email "alice@example.com", :user/foo "foo", :xt/id :user/alice} 178 | {:user/email "bob@example.com", :user/foo "foo", :xt/id :user/bob}) 179 | (sort-by :user/email (biff/lookup-all db :user/foo "foo")))) 180 | (is (= '{:user/email "alice@example.com", 181 | :user/foo "foo", 182 | :xt/id :user/alice, 183 | :user/messages 184 | ({:msg/user :user/alice, 185 | :msg/text "hello", 186 | :msg/sent-at #inst "1970-01-01T00:00:00.000-00:00", 187 | :xt/id :msg/a} 188 | {:msg/user :user/alice, 189 | :msg/text "there", 190 | :msg/sent-at #inst "1971-01-01T00:00:00.000-00:00", 191 | :xt/id :msg/b})} 192 | (-> (biff/lookup db 193 | '[* {(:msg/_user {:as :user/messages}) [*]}] 194 | :user/email 195 | "alice@example.com") 196 | (update :user/messages #(sort-by :msg/sent-at %))))) 197 | (is (#{:user/alice :user/bob} (biff/lookup-id db :user/foo "foo")))))) 198 | --------------------------------------------------------------------------------