Support datahike-cli

.gitignore

@@ -16,6 +16,8 @@ inputFiles.lst
 /ref
 /dist
 *.local.edn
+*.db
+/dthk.edn
 
 /public/js
 /node_modules

NOTES.md

@@ -5,11 +5,19 @@ Notes on potential ideas for Bread. Almost all of this is entirely hypothetical,
 ## Progress
 
 - native-image with Markdown: BLOCKED
-- native-image with Datahike: BLOCKED
+- native-image with Datahike: WIP
 - Babashka with Datahike: BLOCKED
 - JVM on Heroku: ???
 - JVM on Fly.io: ???
 
+## CGI
+
+https://www.cgi101.com/book/ch3/text.html
+
+```
+REQUEST_URL=/en/hello REMOTE_ADDR=127.0.0.1 CONTENT_TYPE='*/*' clojure -M:cms -m systems.bread.alpha.cms.cgi --file bread.cgi.edn
+```
+
 ## bread.main
 
 CGI mode is enabled by default when the `GATEWAY_INTERFACE` env var is detected, or if the `--cgi` flag is passed explicitly. Maybe make a `--no-cgi` flag to disable when env var present?

cms/systems/bread/alpha/cms/cgi.cljc

@@ -0,0 +1,177 @@
+(ns systems.bread.alpha.cms.cgi
+  (:require
+    [clojure.edn :as edn]
+    [clojure.java.io :as io]
+    [clojure.string :as string]
+    [clojure.tools.cli :as cli]
+    [aero.core :as aero]
+    [integrant.core :as ig]
+    [org.httpkit.server :as http]
+    [reitit.core :as reitit]
+    [reitit.ring]
+    [ring.middleware.defaults :as ring]
+    [sci.core :as sci]
+    ;; TODO Timbre
+
+    [systems.bread.alpha.core :as bread]
+    [systems.bread.alpha.cms.theme]
+    [systems.bread.alpha.database :as db]
+    [systems.bread.alpha.plugin.defaults :as defaults]
+    [systems.bread.alpha.cms.config.bread]
+
+(defmethod ig/init-key :bread/db
+  [_ {:keys [recreate? force?] :as db-config}]
+  (db/create! db-config {:force? force?})
+  (assoc db-config :db/connection (db/connect db-config)))
+
+(defmethod ig/halt-key! :bread/db
+  [_ {:keys [recreate?] :as db-config}]
+  (when recreate? (db/delete! db-config)))
+
+(defmethod ig/init-key :bread/router [_ router]
+  router)
+
+(defmethod ig/init-key :bread/app [_ app-config]
+  (bread/load-app (defaults/app app-config)))
+
+(defmethod ig/halt-key! :bread/app [_ app]
+  (bread/shutdown app))
+
+(defmethod ig/init-key :bread/handler [_ app]
+  (bread/handler app))
+
+(defmethod ig/init-key :bread/profilers [_ profilers]
+  ;; Enable hook profiling.
+  (alter-var-root #'bread/*profile-hooks* (constantly true))
+  (map
+    (fn [{h :hook act :action/name f :f :as profiler}]
+      (let [tap (bread/add-profiler
+                  (fn [{{:keys [action hook] :as invocation} ::bread/profile}]
+                    (if (and (or (nil? (seq h)) ((set h)
+                                                 hook))
+                             (or (nil? (seq act)) ((set act)
+                                                   (:action/name action))))
+                      (f invocation))))]
+        (assoc profiler :tap tap)))
+    profilers))
+
+(defmethod ig/halt-key! :bread/profilers [_ profilers]
+  (doseq [{:keys [tap]} profilers]
+    (remove-tap tap)))
+    [systems.bread.alpha.cms.config.reitit]
+    [systems.bread.alpha.plugin.auth :as auth]
+    [systems.bread.alpha.plugin.datahike-cli]
+    [systems.bread.alpha.plugin.reitit])
+  (:import
+    [java.time LocalDateTime]
+    [java.util Properties])
+  (:gen-class))
+
+;; TODO log to stderr
+
+(def status-mappings
+  {200 "OK"
+   400 "Bad Request"
+   404 "Not Found"
+   500 "Internal Server Error"})
+
+(def cli-options
+  [["-h" "--help" "Show this usage text."]
+   ["-p" "--port PORT" "Port number to run the HTTP server on."
+    :parse-fn #(Integer/parseInt %)
+    :validate [#(< 0 % 0x10000) "Must be a number between 0 and 65536."]]
+   ["-f" "--file FILE" "Config file path. Ignored if --config is passed."
+    :default "bread.edn"]
+   ["-c" "--config EDN"
+    "Full configuration data as EDN. Causes other args to be ignored."
+    :parse-fn edn/read-string]])
+
+(defn show-help [{:keys [summary]}]
+  (println summary))
+
+(defn show-errors [{:keys [errors]}]
+  (println (string/join "\n" errors)))
+
+;; TODO mv
+(defmethod ig/init-key :clojure-version [_ _]
+  (clojure-version))
+
+(defmethod ig/init-key :ring/wrap-defaults [_ value]
+  (let [default-configs {:api-defaults ring/api-defaults
+                         :site-defaults ring/site-defaults
+                         :secure-api-defaults ring/secure-api-defaults
+                         :secure-site-defaults ring/secure-api-defaults}
+        k (if (keyword? value) value (get value :ring-defaults))
+        defaults (get default-configs k)
+        defaults (if (map? value)
+                   (reduce #(assoc-in %1 (key %2) (val %2))
+                           defaults (dissoc value :ring-defaults))
+                   defaults)]
+    defaults))
+
+(defmethod ig/init-key :ring/session-store
+  [_ {store-type :store/type {conn :db/connection} :store/db}]
+  ;; TODO extend with a multimethod??
+  (when (= :datalog store-type)
+    (auth/session-store conn)))
+;; /mv
+
+(defn log-hook! [invocation]
+  (let [{:keys [hook action result]} invocation]
+    (prn (:action/name action) (select-keys result
+                                            [:params
+                                             :headers
+                                             :status
+                                             :session]))))
+
+(defn get-merged-config [path]
+  (merge
+    (aero/read-config (io/resource "default.cgi.edn"))
+    (aero/read-config path)))
+
+(defn run-as-cgi [{:keys [options]}]
+  (try
+    ;; TODO this is pretty jank, update to parse HTTP requests properly
+    (let [[uri & _] (some-> (System/getenv "REQUEST_URI")
+                            (clojure.string/split #"\?"))
+          ;; TODO merge with defaults
+          config (get-merged-config (:file options))
+          handler (:bread/handler (ig/init config))
+          req {:uri uri
+               :query-string (System/getenv "QUERY_STRING")
+               :remote-addr (System/getenv "REMOTE_ADDR")
+               :server-name (System/getenv "SERVER_NAME")
+               :server-port (System/getenv "SERVER_PORT")
+               :content-type (System/getenv "CONTENT_TYPE")
+               :content-length (Integer.
+                                 (or (System/getenv "CONTENT_LENGTH") "0"))}
+          {:keys [status headers body] :as res} (handler req)]
+      (println (str "status: " status " " (status-mappings status)))
+      (doseq [[header header-value] headers]
+        (println (str header ": " header-value)))
+      (println)
+      (println body)
+      (System/exit 0))
+    (catch Throwable e
+      (println "status: 500 Internal Server Error")
+      (println "content-type: text/plain")
+      (println)
+      (println (.getMessage e))
+      (println (.getStackTrace e))
+      (System/exit 1))))
+
+(comment
+  (set! *print-namespace-maps* false)
+
+  (require '[kaocha.repl :as k])
+  (k/run :unit)
+
+  (-main))
+
+(defn -main [& args]
+  (let [{:keys [options errors] :as cli-env} (cli/parse-opts args cli-options)
+        {:keys [help port file config cgi]} options]
+    (cond
+      errors (show-errors cli-env)
+      help (show-help cli-env)
+      :else (run-as-cgi cli-env))))

cms/systems/bread/alpha/cms/config/bread.cljc

@@ -1,7 +1,13 @@
 (ns systems.bread.alpha.cms.config.bread
   (:require
     [aero.core :as aero]
-    [integrant.core :as ig]))
+    [integrant.core :as ig]
+
+    [systems.bread.alpha.core :as bread]
+    [systems.bread.alpha.plugin.defaults :as defaults]
+    [systems.bread.alpha.database :as db])
+  (:import
+    [java.time LocalDateTime]))
 
 (defmethod aero/reader 'ig/ref [_ _ value]
   (ig/ref value))
@@ -25,3 +31,49 @@
 
 (defmethod aero/reader 'concat [_ _ args]
   (apply concat args))
+
+(defmethod ig/init-key :bread/started-at [_ _]
+  (LocalDateTime/now))
+
+(defmethod ig/init-key :bread/initial-config [_ config]
+  config)
+
+(defmethod ig/init-key :bread/db
+  [_ {:keys [recreate? force?] :as db-config}]
+  (db/create! db-config {:force? force?})
+  (assoc db-config :db/connection (db/connect db-config)))
+
+(defmethod ig/halt-key! :bread/db
+  [_ {:keys [recreate?] :as db-config}]
+  (when recreate? (db/delete! db-config)))
+
+(defmethod ig/init-key :bread/router [_ router]
+  router)
+
+(defmethod ig/init-key :bread/app [_ app-config]
+  (bread/load-app (defaults/app app-config)))
+
+(defmethod ig/halt-key! :bread/app [_ app]
+  (bread/shutdown app))
+
+(defmethod ig/init-key :bread/handler [_ app]
+  (bread/handler app))
+
+(defmethod ig/init-key :bread/profilers [_ profilers]
+  ;; Enable hook profiling.
+  (alter-var-root #'bread/*profile-hooks* (constantly true))
+  (map
+    (fn [{h :hook act :action/name f :f :as profiler}]
+      (let [tap (bread/add-profiler
+                  (fn [{{:keys [action hook] :as invocation} ::bread/profile}]
+                    (if (and (or (nil? (seq h)) ((set h)
+                                                 hook))
+                             (or (nil? (seq act)) ((set act)
+                                                   (:action/name action))))
+                      (f invocation))))]
+        (assoc profiler :tap tap)))
+    profilers))
+
+(defmethod ig/halt-key! :bread/profilers [_ profilers]
+  (doseq [{:keys [tap]} profilers]
+    (remove-tap tap)))

cms/systems/bread/alpha/cms/config/server.cljc

@@ -0,0 +1,38 @@
+(ns systems.bread.alpha.cms.config.server
+  (:require
+    [aero.core :as aero]
+    [integrant.core :as ig]
+    [org.httpkit.server :as http]
+    [ring.middleware.defaults :as ring]
+
+    [systems.bread.alpha.plugin.auth :as auth]))
+
+(defmethod ig/init-key :http [_ {:keys [port handler wrap-defaults]}]
+  (println "Starting HTTP server on port" port)
+  (let [handler (if wrap-defaults
+                  (ring/wrap-defaults handler wrap-defaults)
+                  handler)]
+    (http/run-server handler {:port port})))
+
+(defmethod ig/halt-key! :http [_ stop-server]
+  (when-let [prom (stop-server :timeout 100)]
+    @prom))
+
+(defmethod ig/init-key :ring/wrap-defaults [_ value]
+  (let [default-configs {:api-defaults ring/api-defaults
+                         :site-defaults ring/site-defaults
+                         :secure-api-defaults ring/secure-api-defaults
+                         :secure-site-defaults ring/secure-api-defaults}
+        k (if (keyword? value) value (get value :ring-defaults))
+        defaults (get default-configs k)
+        defaults (if (map? value)
+                   (reduce #(assoc-in %1 (key %2) (val %2))
+                           defaults (dissoc value :ring-defaults))
+                   defaults)]
+    defaults))
+
+(defmethod ig/init-key :ring/session-store
+  [_ {store-type :store/type {conn :db/connection} :store/db}]
+  ;; TODO extend with a multimethod??
+  (when (= :datalog store-type)
+    (auth/session-store conn)))