diff --git a/.gitignore b/.gitignore index ab340ea51..095e320e5 100644 --- a/.gitignore +++ b/.gitignore @@ -16,6 +16,8 @@ inputFiles.lst /ref /dist *.local.edn +*.db +/dthk.edn /public/js /node_modules diff --git a/NOTES.md b/NOTES.md index 5d13e3fb0..98bcc0ee7 100644 --- a/NOTES.md +++ b/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? diff --git a/cms/systems/bread/alpha/cms/cgi.cljc b/cms/systems/bread/alpha/cms/cgi.cljc new file mode 100644 index 000000000..5829d7e6c --- /dev/null +++ b/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)))) diff --git a/cms/systems/bread/alpha/cms/config/bread.cljc b/cms/systems/bread/alpha/cms/config/bread.cljc index d5fe5d420..2a5d2e356 100644 --- a/cms/systems/bread/alpha/cms/config/bread.cljc +++ b/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))) diff --git a/cms/systems/bread/alpha/cms/config/server.cljc b/cms/systems/bread/alpha/cms/config/server.cljc new file mode 100644 index 000000000..b32c6e134 --- /dev/null +++ b/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))) diff --git a/cms/systems/bread/alpha/cms/main.cljc b/cms/systems/bread/alpha/cms/main.cljc index 273e84537..62434087f 100644 --- a/cms/systems/bread/alpha/cms/main.cljc +++ b/cms/systems/bread/alpha/cms/main.cljc @@ -6,12 +6,9 @@ [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 ring middlewares [systems.bread.alpha.core :as bread] [systems.bread.alpha.cms.theme] @@ -19,11 +16,11 @@ [systems.bread.alpha.plugin.defaults :as defaults] [systems.bread.alpha.cms.config.bread] [systems.bread.alpha.cms.config.reitit] + [systems.bread.alpha.cms.config.server] [systems.bread.alpha.plugin.auth :as auth] [systems.bread.alpha.plugin.datahike] [systems.bread.alpha.plugin.reitit]) (:import - [java.time LocalDateTime] [java.util Properties]) (:gen-class)) @@ -38,7 +35,7 @@ ["-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 --file is passed." + ["-f" "--file FILE" "Config file path. Ignored if --config is passed." :default "config.edn"] ["-c" "--config EDN" "Full configuration data as EDN. Causes other args to be ignored." @@ -88,110 +85,25 @@ (defn start! [config] (let [config (assoc config - :initial-config config - ;; These will be initialized by Integrant: - ;; TODO bread version + :bread/initial-config config + ;; These will be initialized by Integrant... :clojure-version nil - :started-at nil)] + ;; TODO bread version + :bread/started-at nil)] (reset! system (ig/init config)))) +(defmethod ig/init-key :clojure-version [_ _] + (clojure-version)) + (defn stop! [] (when-let [sys @system] (ig/halt! sys) (reset! system nil))) -(defmethod ig/init-key :initial-config [_ config] - config) - -(defmethod ig/init-key :clojure-version [_ _] - (clojure-version)) - -(defmethod ig/init-key :started-at [_ _] - (LocalDateTime/now)) - -(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))) - -(defmethod ig/init-key :bread/db - [_ {:keys [recreate? force?] :as db-config}] - ;; TODO call datahike API directly - (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}] - ;; TODO call datahike API directly - (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)) - -(defn log-hook! [invocation] - (let [{:keys [hook action result]} invocation] - (prn (:action/name action) (select-keys result - [:params - :headers - :status - :session])))) - -(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 bread/effect ::hello [effect data] - (throw (ex-info "oh no!" {})) - (future "HELLO!")) - -(defmethod ig/halt-key! :bread/profilers [_ profilers] - (doseq [{:keys [tap]} profilers] - (remove-tap tap))) +(defn get-merged-config [path] + (merge + (aero/read-config (io/resource "default.main.edn")) + (aero/read-config path))) (defn restart! [config] (stop!) @@ -200,7 +112,17 @@ (comment (set! *print-namespace-maps* false) - (restart! (-> "dev/main.edn" aero/read-config)) + (merge + (-> "default.main.edn" io/resource aero/read-config) + (-> "dev/main.edn" aero/read-config)) + (get-merged-config "dev/main.edn") + + (try (restart! (get-merged-config "dev/main.edn")) + (catch clojure.lang.ExceptionInfo e + (-> e ex-cause ((juxt (comp :action/name :action ex-data) + (comp ex-message ex-cause) + (comp :out ex-data ex-cause) + (comp :reason ex-data)))))) (deref system) (:http @system) (:ring/wrap-defaults @system) @@ -504,7 +426,7 @@ config (start! config) file (if-not (.exists (io/file file)) (show-errors {:errors [(str "No such file: " file)]}) - (let [config (-> file aero/read-config + (let [config (-> file get-merged-config (update-in [:http :port] #(if port port %)))] (start! config))) :else (show-help cli-env)))) diff --git a/cms/systems/bread/alpha/cms/theme.cljc b/cms/systems/bread/alpha/cms/theme.cljc index 3a5668ef7..bd3f4956a 100644 --- a/cms/systems/bread/alpha/cms/theme.cljc +++ b/cms/systems/bread/alpha/cms/theme.cljc @@ -72,8 +72,6 @@ {:post/taxons [{:translatable/fields [*]}]}]} [:main [:h1 (:title fields)] - [:p "Hello result: " (pr-str @hello)] - [:p "Hello error: " (-> hello meta :errors first (.getMessage))] [:div.tags-list (map (fn [{tag :translatable/fields}] [:span.tag (:name tag)]) diff --git a/dev/cgi.edn b/dev/cgi.edn index 2732c9d7b..4e9deed5b 100644 --- a/dev/cgi.edn +++ b/dev/cgi.edn @@ -1,35 +1,68 @@ -{:bread/handler #ig/ref :bread/app - :bread/app {:db false - :i18n false - :routes - {:router #ig/ref :bread/router} - :plugins []} +{:bread/app + {:db #ig/ref :bread/db + :auth {:lock-seconds 10} + :i18n {:supported-langs #{:en :fr}} + :routes {:router #ig/ref :bread/router} + :components {:not-found #var systems.bread.alpha.cms.theme/NotFoundPage} + :navigation {:menus {:main-nav + {:menu/type :systems.bread.alpha.navigation/location + :menu/location :primary + :route/name :page}}}} + + :bread/db + {:db/type :datahike-cli + :store {:backend :file + :path "/home/tamayo/projects/bread-cms/dthk.db", + :config {:in-place? true}} + :recreate? true + :force? true + :attribute-refs? true + :keep-history? true, + :schema-flexibility :write, + :cli/dthk-path "/home/tamayo/bin/dthk", + :cli/config-path "/home/tamayo/projects/bread-cms/dthk.edn" + :db/initial-txns + #concat [#deref #var systems.bread.alpha.plugin.defaults/initial-data + [{:user/username "coby" + :user/name "Coby Tamayo" + :user/email "coby@bread.systems" + :user/password #buddy/derive ["hello" :bcrypt+blake2b-512] + #_#_ ;; Uncomment to enable 2FA + :user/two-factor-key "AWWMEFM4ADBSQRET" + :user/failed-login-count 0 + :user/lang :en-US + :user/roles + #{{:role/key :author + :role/abilities + #{{:ability/key :publish-posts} + {:ability/key :edit-posts} + {:ability/key :delete-posts}}}}}]]} + + ;; TODO routes.edn ? :bread/router - #router - [["/:lang" - ["" - {:name :home - :bread/dispatcher - {:dispatcher/type :systems.bread.alpha.cms.scratch/static - :dispatcher/component - #var systems.bread.alpha.cms.scratch/home-page}}] - ["/articles" - {:name :articles - :bread/dispatcher - {:dispatcher/type :systems.bread.alpha.cms.blog/article - ;; TODO article component - :dispatcher/component - #var systems.bread.alpha.cms.scratch/interior-page}}] - ["/article/:slug" - {:name :article - :bread/dispatcher - {:dispatcher/type :systems.bread.alpha.cms.blog/article - :dispatcher/component - #var systems.bread.alpha.cms.scratch/interior-page}}] - ["/:slug" - {:name :page - :bread/dispatcher - {:dispatcher/type :systems.bread.alpha.cms.scratch/static - :dispatcher/component - #var systems.bread.alpha.cms.scratch/home-page}}]] + #reitit/router + [[["/login" + {:name :login + :dispatcher/type :systems.bread.alpha.plugin.auth/login + :dispatcher/component #var systems.bread.alpha.plugin.auth/login-page}] + ["/assets/*" + #invoke [reitit.ring/create-resource-handler + {:param :filename}]] + ["/{field/lang}" + ["" + {:name :home + :dispatcher/type :dispatcher.type/page + :dispatcher/component #var systems.bread.alpha.cms.theme/HomePage}] + ["/tag/{thing/slug}" + {:name :tag + :dispatcher/type :dispatcher.type/tag + :dispatcher/component #var systems.bread.alpha.cms.theme/Tag}] + ["/{thing/slug*}" + {:name :page + :dispatcher/type :dispatcher.type/page + :dispatcher/component #var systems.bread.alpha.cms.theme/InteriorPage}] + ["/page/{thing/slug*}" + {:name :page! + :dispatcher/type :dispatcher.type/page + :dispatcher/component #var systems.bread.alpha.cms.theme/InteriorPage}]]] {:conflicts nil}]} diff --git a/dev/main.edn b/dev/main.edn index 74c5e1f27..2c664d69b 100644 --- a/dev/main.edn +++ b/dev/main.edn @@ -1,14 +1,4 @@ -{:http {:port 1312 - :handler #ig/ref :bread/handler - :wrap-defaults #ig/ref :ring/wrap-defaults} - :ring/wrap-defaults {:ring-defaults :site-defaults - [:session :store] #ig/ref :ring/session-store - [:security :anti-forgery] false} - :ring/session-store - {:store/type :datalog - :store/db #ig/ref :bread/db} - :bread/handler #ig/ref :bread/app - :bread/app +{:bread/app {:db #ig/ref :bread/db :auth {:lock-seconds 10} :i18n {:supported-langs #{:en :fr}} @@ -17,10 +7,8 @@ :navigation {:menus {:main-nav {:menu/type :systems.bread.alpha.navigation/location :menu/location :primary - :route/name :page}}} - :plugins [{:effects - [{:effect/name :systems.bread.alpha.cms.main/hello - :effect/data-key :hello}]}]} + :route/name :page}}}} + :bread/db {:db/type :datahike :store {:backend :mem @@ -44,6 +32,7 @@ #{{:ability/key :publish-posts} {:ability/key :edit-posts} {:ability/key :delete-posts}}}}}]]} + :bread/router #reitit/router [[["/login" @@ -70,14 +59,4 @@ {:name :page! :dispatcher/type :dispatcher.type/page :dispatcher/component #var systems.bread.alpha.cms.theme/InteriorPage}]]] - {:conflicts nil}] - :bread/profilers - [#_{:hook #{:systems.bread.alpha.core/response} - :action/name #{:systems.bread.alpha.cms.defaults/response} - :f #var systems.bread.alpha.cms.main/log-hook!}] - #_#_ - :bread/debugger - {:http - {:port 1313 - :docroot "public/debugger" - :middleware [#var systems.bread.alpha.cms.main/wrap-debug]}}} + {:conflicts nil}]} diff --git a/plugins/auth/systems/bread/alpha/plugin/auth.cljc b/plugins/auth/systems/bread/alpha/plugin/auth.cljc index 5d85a373f..c9a724987 100644 --- a/plugins/auth/systems/bread/alpha/plugin/auth.cljc +++ b/plugins/auth/systems/bread/alpha/plugin/auth.cljc @@ -25,12 +25,12 @@ sk)) (ss/read-session [_ sk] (let [sk (->uuid sk) - data (db/q @conn - '{:find [?data .] - :in [$ ?sk] - :where [[?e :session/data ?data] - [?e :session/uuid ?sk]]} - sk)] + data (db/q (db/db conn) + '{:find [?data .] + :in [$ ?sk] + :where [[?e :session/data ?data] + [?e :session/uuid ?sk]]} + sk)] (edn/read-string data))) (ss/write-session [_ sk data] (let [sk (or (->uuid sk) (UUID/randomUUID))] diff --git a/plugins/datahike/systems/bread/alpha/plugin/datahike.cljc b/plugins/datahike/systems/bread/alpha/plugin/datahike.cljc index 6bbf7a282..0991e6637 100644 --- a/plugins/datahike/systems/bread/alpha/plugin/datahike.cljc +++ b/plugins/datahike/systems/bread/alpha/plugin/datahike.cljc @@ -4,12 +4,10 @@ [clojure.core.protocols :refer [Datafiable]] [datahike.api :as d] [datahike.db :as dhdb] - [systems.bread.alpha.schema :as schema] [systems.bread.alpha.core :as bread] [systems.bread.alpha.database :as db]) (:import - [java.lang IllegalArgumentException] - [java.util UUID])) + [java.lang IllegalArgumentException])) diff --git a/plugins/datahike/systems/bread/alpha/plugin/datahike_cli.cljc b/plugins/datahike/systems/bread/alpha/plugin/datahike_cli.cljc new file mode 100644 index 000000000..9c60d2b01 --- /dev/null +++ b/plugins/datahike/systems/bread/alpha/plugin/datahike_cli.cljc @@ -0,0 +1,256 @@ +(ns systems.bread.alpha.plugin.datahike-cli + (:require + [clojure.edn :as edn] + [clojure.pprint :refer [pprint]] + [clojure.core.protocols :refer [Datafiable]] + [clojure.java.shell :refer [sh]] + [clojure.string :refer [split]] + + [systems.bread.alpha.schema :as schema] + [systems.bread.alpha.core :as bread] + [systems.bread.alpha.database :as db]) + (:import + [java.lang IllegalArgumentException] + [java.util UUID])) + +(defprotocol CliParam + (-to-param [x])) + +(extend-protocol CliParam + java.util.UUID + (-to-param [uuid] (pr-str (str uuid))) + + java.lang.Object + (-to-param [x] (str x))) + +(comment + (pr-str (UUID/randomUUID)) + (-to-param (UUID/randomUUID))) + +(defn- dthk [{:cli/keys [dthk-path]} cmd & args] + (prn (apply list 'sh dthk-path (name cmd) (map -to-param args))) + (apply sh dthk-path (name cmd) (map -to-param args))) + +(defn- q* [config & cmd] + (let [{:keys [out err exit] :as result} (apply dthk config cmd)] + (if (zero? exit) + (try + (edn/read-string out) + (catch Throwable ex + (throw (ex-info (str "Error parsing output from `dthk` command: " + (ex-message ex)) + (assoc result + :reason :error-parsing-edn + :config config + :cmd-args cmd) + ex)))) + (let [[msg] (split err #"\n")] + (throw (ex-info (str "Error running `dthk` command: " msg) + (assoc result + :reason :error-running-dthk-command + :config config + :cmd-args cmd))))))) + +(defn- prefix + ([pre config] + (str pre (:cli/config-path config))) + ([config] + (prefix "db:" config))) + +(defn- asof-prefix [instant-ms config] + (prefix (str "asof:" instant-ms) config)) + +(defn- hist-prefix [config] + (prefix (str "history:") config)) + +(deftype AsOfDatahikeClient [instant-ms config] + db/TemporalDatabase + (q [db query] + (q* config :query (pr-str query) (asof-prefix instant-ms config))) + (q [db query a] + (q* config :query (pr-str query) (asof-prefix instant-ms config) a)) + (q [db query a b] + (q* config :query (pr-str query) (asof-prefix instant-ms config) a b)) + (q [db query a b c] + (q* config :query (pr-str query) (asof-prefix instant-ms config) a b c)) + (q [db query a b c d] + (q* config :query (pr-str query) (asof-prefix instant-ms config) a b c d)) + (q [db query a b c d e] + (q* config :query (pr-str query) (asof-prefix instant-ms config) a b c d e)) + (q [db query a b c d e f] + (q* config :query (pr-str query) (asof-prefix instant-ms config) a b c d e f)) + (q [db query a b c d e f g] + (q* config :query (pr-str query) (asof-prefix instant-ms config) a b c d e f g)) + (q [db query a b c d e f g h] + (q* config :query (pr-str query) (asof-prefix instant-ms config) a b c d e f g h)) + (q [db query a b c d e f g h i] + (q* config :query (pr-str query) (asof-prefix instant-ms config) a b c d e f g h i)) + (q [db query a b c d e f g h i j] + (q* config :query (pr-str query) (asof-prefix instant-ms config) a b c d e f g h i j)) + (q [db query a b c d e f g h i j k] + (q* config :query (pr-str query) (asof-prefix instant-ms config) a b c d e f g h i j k)) + (q [db query a b c d e f g h i j k l] + (q* config :query (pr-str query) (asof-prefix instant-ms config) a b c d e f g h i j k l)) + (q [db query a b c d e f g h i j k l m] + (q* config :query (pr-str query) (asof-prefix instant-ms config) a b c d e f g h i j k l m)) + (q [db query a b c d e f g h i j k l m n] + (q* config :query (pr-str query) (asof-prefix instant-ms config) a b c d e f g h i j k l m n)) + (q [db query a b c d e f g h i j k l m n o] + (q* config :query (pr-str query) (asof-prefix instant-ms config) a b c d e f g h i j k l m n o)) + (q [db query a b c d e f g h i j k l m n o p] + (q* config :query (pr-str query) (asof-prefix instant-ms config) a b c d e f g h i j k l m n o p)) + (q [db query a b c d e f g h i j k l m n o p r] + (q* config :query (pr-str query) (asof-prefix instant-ms config) a b c d e f g h i j k l m n o p r)) + (pull [db spec ident] + (q* config :pull spec ident))) + +(deftype DatahikeCommandLineInterfaceClient [config] + db/TemporalDatabase + (as-of [_ instant-ms] + (AsOfDatahikeClient. instant-ms config)) + (history [_] + (HistoricalDatahikeClient. config)) + (q [db query] + (q* config :query (pr-str query) (prefix config))) + (q [db query a] + (q* config :query (pr-str query) (prefix config) a)) + (q [db query a b] + (q* config :query (pr-str query) (prefix config) a b)) + (q [db query a b c] + (q* config :query (pr-str query) (prefix config) a b c)) + (q [db query a b c d] + (q* config :query (pr-str query) (prefix config) a b c d)) + (q [db query a b c d e] + (q* config :query (pr-str query) (prefix config) a b c d e)) + (q [db query a b c d e f] + (q* config :query (pr-str query) (prefix config) a b c d e f)) + (q [db query a b c d e f g] + (q* config :query (pr-str query) (prefix config) a b c d e f g)) + (q [db query a b c d e f g h] + (q* config :query (pr-str query) (prefix config) a b c d e f g h)) + (q [db query a b c d e f g h i] + (q* config :query (pr-str query) (prefix config) a b c d e f g h i)) + (q [db query a b c d e f g h i j] + (q* config :query (pr-str query) (prefix config) a b c d e f g h i j)) + (q [db query a b c d e f g h i j k] + (q* config :query (pr-str query) (prefix config) a b c d e f g h i j k)) + (q [db query a b c d e f g h i j k l] + (q* config :query (pr-str query) (prefix config) a b c d e f g h i j k l)) + (q [db query a b c d e f g h i j k l m] + (q* config :query (pr-str query) (prefix config) a b c d e f g h i j k l m)) + (q [db query a b c d e f g h i j k l m n] + (q* config :query (pr-str query) (prefix config) a b c d e f g h i j k l m n)) + (q [db query a b c d e f g h i j k l m n o] + (q* config :query (pr-str query) (prefix config) a b c d e f g h i j k l m n o)) + (q [db query a b c d e f g h i j k l m n o p] + (q* config :query (pr-str query) (prefix config) a b c d e f g h i j k l m n o p)) + (q [db query a b c d e f g h i j k l m n o p r] + (q* config :query (pr-str query) (prefix config) a b c d e f g h i j k l m n o p r)) + + (pull [db spec ident] + (q* config :pull (prefix config) (pr-str spec) ident)) + + db/TransactionalDatabaseConnection + (db [conn] + conn) + (transact [_ txs] + (q* config :transact (prefix "conn:" config) (pr-str txs)))) + +(deftype HistoricalDatahikeClient [config] + db/TemporalDatabase + (q [db query] + (q* config :history (pr-str query) (hist-prefix config))) + (q [db query a] + (q* config :history (pr-str query) (hist-prefix config) a)) + (q [db query a b] + (q* config :history (pr-str query) (hist-prefix config) a b)) + (q [db query a b c] + (q* config :history (pr-str query) (hist-prefix config) a b c)) + (q [db query a b c d] + (q* config :history (pr-str query) (hist-prefix config) a b c d)) + (q [db query a b c d e] + (q* config :history (pr-str query) (hist-prefix config) a b c d e)) + (q [db query a b c d e f] + (q* config :history (pr-str query) (hist-prefix config) a b c d e f)) + (q [db query a b c d e f g] + (q* config :history (pr-str query) (hist-prefix config) a b c d e f g)) + (q [db query a b c d e f g h] + (q* config :history (pr-str query) (hist-prefix config) a b c d e f g h)) + (q [db query a b c d e f g h i] + (q* config :history (pr-str query) (hist-prefix config) a b c d e f g h i)) + (q [db query a b c d e f g h i j] + (q* config :history (pr-str query) (hist-prefix config) a b c d e f g h i j)) + (q [db query a b c d e f g h i j k] + (q* config :history (pr-str query) (hist-prefix config) a b c d e f g h i j k)) + (q [db query a b c d e f g h i j k l] + (q* config :history (pr-str query) (hist-prefix config) a b c d e f g h i j k l)) + (q [db query a b c d e f g h i j k l m] + (q* config :history (pr-str query) (hist-prefix config) a b c d e f g h i j k l m)) + (q [db query a b c d e f g h i j k l m n] + (q* config :history (pr-str query) (hist-prefix config) a b c d e f g h i j k l m n)) + (q [db query a b c d e f g h i j k l m n o] + (q* config :history (pr-str query) (hist-prefix config) a b c d e f g h i j k l m n o)) + (q [db query a b c d e f g h i j k l m n o p] + (q* config :history (pr-str query) (hist-prefix config) a b c d e f g h i j k l m n o p)) + (q [db query a b c d e f g h i j k l m n o p r] + (q* config :history (pr-str query) (hist-prefix config) a b c d e f g h i j k l m n o p r))) + +(comment + + (require '[aero.core :as aero]) + + (def config + (-> "dev/main.edn" aero/read-config :bread/db)) + + (def config + {:store {:backend :file + :path "/home/tamayo/projects/bread-cms/example.db" + :config {:in-place? true}} + :attribute-refs? true + :keep-history? true + :schema-flexibility :write + :db/type :datahike-cli + :cli/dthk-path "/home/tamayo/bin/dthk" + :cli/config-path "/home/tamayo/projects/bread-cms/example.edn"}) + + (apply sh "/home/tamayo/bin/dthk" (map name [:create-database :dthk.edn])) + + (db/create! config) + (db/delete! config) + + (edn/read-string "{:find [(pull ?e [*])] :where [[?e :person/name]]}") + (edn/read-string "[:find [(pull ?e [*])] :where [?e :person/name]]") + + (def $conn (db/connect config)) + (def $db (db/db $conn)) + + (dthk config :query + (pr-str '{:find [(pull ?e [:db/ident :db/doc])] + :in [$] + :where [[?e :db/ident :attr/migration]]}) + "db:dthk.edn") + (db/q $db '{:find [(pull ?e [:db/ident :db/doc])] + :in [$] + :where [[?e :db/ident :attr/migration]]}) + + ) + +(defmethod db/connect :datahike-cli [config] + (DatahikeCommandLineInterfaceClient. config)) + +(defmethod db/delete! :datahike-cli [{:cli/keys [config-path] :as config}] + (-> (dthk config :delete-database config-path) + :out edn/read-string)) + +(defmethod db/create! :datahike-cli [config & [{:keys [force?]}]] + (let [{:cli/keys [dthk-path config-path]} config] + (println "writing config") + (spit config-path (with-out-str (pprint config))) + (let [{:keys [out err]} (dthk config :create-database config-path)] + ;; TODO parse Java stacktrace + (if (and (re-find #"Database already exists." err) force?) + (do + (dthk config :delete-database config-path) + (-> (dthk config :create-database config-path) + :out edn/read-string)) + (edn/read-string out))))) diff --git a/resources/default.cgi.edn b/resources/default.cgi.edn new file mode 100644 index 000000000..69488fa28 --- /dev/null +++ b/resources/default.cgi.edn @@ -0,0 +1,18 @@ +{:ring/wrap-defaults {:ring-defaults :site-defaults + [:session :store] #ig/ref :ring/session-store + [:security :anti-forgery] false} + + :ring/session-store + {:store/type :datalog + :store/db #ig/ref :bread/db} + + :bread/handler #ig/ref :bread/app + + :bread/profilers [] + + #_#_ ;; TODO + :bread/debugger + {:http + {:port 1313 + :docroot "public/debugger" + :middleware [#var systems.bread.alpha.cms.main/wrap-debug]}}} diff --git a/resources/default.main.edn b/resources/default.main.edn new file mode 100644 index 000000000..3f6b36857 --- /dev/null +++ b/resources/default.main.edn @@ -0,0 +1,22 @@ +{:http {:port 1312 + :handler #ig/ref :bread/handler + :wrap-defaults #ig/ref :ring/wrap-defaults} + + :ring/wrap-defaults {:ring-defaults :site-defaults + [:session :store] #ig/ref :ring/session-store + [:security :anti-forgery] false} + + :ring/session-store + {:store/type :datalog + :store/db #ig/ref :bread/db} + + :bread/handler #ig/ref :bread/app + + :bread/profilers [] + + #_#_ ;; TODO + :bread/debugger + {:http + {:port 1313 + :docroot "public/debugger" + :middleware [#var systems.bread.alpha.cms.main/wrap-debug]}}} diff --git a/src/systems/bread/alpha/core.cljc b/src/systems/bread/alpha/core.cljc index bfa203146..c493ca976 100644 --- a/src/systems/bread/alpha/core.cljc +++ b/src/systems/bread/alpha/core.cljc @@ -233,7 +233,6 @@ (throw (if (-> e# ex-data ::core?) e# (ex-info (.getMessage e#) (merge (ex-data e#) {:hook ~hook - :app ~app :action ~current-action :args ~args ::core? true}) diff --git a/src/systems/bread/alpha/database.cljc b/src/systems/bread/alpha/database.cljc index 611a98f33..5b0fa52a0 100644 --- a/src/systems/bread/alpha/database.cljc +++ b/src/systems/bread/alpha/database.cljc @@ -95,6 +95,11 @@ ks (migration-keys db)] (contains? ks (migration-key migration)))) +(defn unmet-deps [db migration] + (let [deps (:migration/dependencies (meta migration))] + (when (seq deps) + (filter (complement (migration-keys db)) deps)))) + (defmethod bread/effect ::transact [{:keys [conn txs]} _] (transact conn {:tx-data txs})) @@ -127,12 +132,11 @@ (doseq [migration migrations] ;; Get a new db instance each time, to see the latest migrations (let [db (database app) - unmet-deps (filter - (complement (migration-keys db)) - (:migration/dependencies (meta migration)))] - (when (seq unmet-deps) + unmet (unmet-deps db migration)] + (when (seq unmet) (throw (ex-info "Migration has one or more unmet dependencies!" - {:unmet-deps (set unmet-deps)}))) + {:migration migration + :unmet-deps (set unmet)}))) (when-not (migration-ran? (database app) migration) (transact conn migration))))) app) @@ -192,8 +196,12 @@ :db/as-of-tx? as-of-tx?} :hooks {::bread/init - [{:action/name ::migrate :migrations migrations} - {:action/name ::transact-initial :txs initial-txns}] + [{:action/name ::migrate + :action/description "Run database schema migrations." + :migrations migrations} + {:action/name ::transact-initial + :action/description "Transact initial data into the database." + :txs initial-txns}] ::timepoint [{:action/name ::timepoint :action/description diff --git a/test/core/systems/bread/alpha/core_test.clj b/test/core/systems/bread/alpha/core_test.clj index eb28c86c2..4913407f7 100644 --- a/test/core/systems/bread/alpha/core_test.clj +++ b/test/core/systems/bread/alpha/core_test.clj @@ -447,7 +447,6 @@ (is (thrown-with-msg? ExceptionInfo #"something bad happened" (bread/hook app :throw))) (is (= {:hook :throw - :app app :action {:action/name ::throw :ex ex} :args [1 2 3] ::bread/core? true}