diff --git a/kidlisp-sidecar/.gitignore b/kidlisp-sidecar/.gitignore new file mode 100644 index 0000000000..5835492be1 --- /dev/null +++ b/kidlisp-sidecar/.gitignore @@ -0,0 +1,7 @@ +target/ +.cpcache/ +.nrepl-port +.clj-kondo/.cache/ +.lsp/.cache/ +*.log +.DS_Store diff --git a/kidlisp-sidecar/deploy.fish b/kidlisp-sidecar/deploy.fish new file mode 100644 index 0000000000..82cf5fdf16 --- /dev/null +++ b/kidlisp-sidecar/deploy.fish @@ -0,0 +1,96 @@ +#!/usr/bin/env fish +## Builds the kidlisp-sidecar uberjar and ships it to silo. +## Assumes silo/datomic/deploy.fish has already set up the transactor. +## +## Usage: +## fish deploy.fish Full deploy (build + ship + restart) +## fish deploy.fish --no-build Ship existing uberjar only + +set RED '\033[0;31m' +set GREEN '\033[0;32m' +set YELLOW '\033[1;33m' +set NC '\033[0m' + +set SCRIPT_DIR (dirname (status --current-filename)) +set VAULT_DIR "$SCRIPT_DIR/../aesthetic-computer-vault" +set SSH_KEY "$VAULT_DIR/home/.ssh/id_rsa" +set SIDECAR_ENV_GPG "$VAULT_DIR/kidlisp-datomic/sidecar.env.gpg" +set SILO_HOST "silo.aesthetic.computer" +set SILO_USER "root" +set REMOTE_DIR "/opt/kidlisp-sidecar" +set JAR "$SCRIPT_DIR/target/kidlisp-sidecar.jar" + +set DO_BUILD true +if contains -- --no-build $argv + set DO_BUILD false +end + +## Prereqs +if not test -f $SSH_KEY + echo -e "$RED x SSH key not found: $SSH_KEY$NC" + exit 1 +end + +if not test -f $SIDECAR_ENV_GPG + echo -e "$RED x Vault file missing: $SIDECAR_ENV_GPG$NC" + echo -e "$YELLOW Populate via vault workflow before deploying.$NC" + exit 1 +end + +## Build +if test $DO_BUILD = true + echo -e "$GREEN-> Building uberjar...$NC" + cd $SCRIPT_DIR + clojure -X:uberjar + if test $status -ne 0 + echo -e "$RED x Build failed.$NC" + exit 1 + end +end + +if not test -f $JAR + echo -e "$RED x Uberjar not found: $JAR$NC" + exit 1 +end + +## Decrypt env locally, upload, then wipe local copy +set TMP_ENV (mktemp) +gpg --decrypt --quiet --output $TMP_ENV $SIDECAR_ENV_GPG +if test $status -ne 0 + echo -e "$RED x gpg decrypt failed.$NC" + rm -f $TMP_ENV + exit 1 +end + +echo -e "$GREEN-> Uploading jar + env + systemd unit...$NC" +scp -i $SSH_KEY -o StrictHostKeyChecking=no \ + $JAR \ + $SILO_USER@$SILO_HOST:$REMOTE_DIR/kidlisp-sidecar.jar +scp -i $SSH_KEY -o StrictHostKeyChecking=no \ + $TMP_ENV \ + $SILO_USER@$SILO_HOST:$REMOTE_DIR/.env +scp -i $SSH_KEY -o StrictHostKeyChecking=no \ + $SCRIPT_DIR/kidlisp-sidecar.service \ + $SILO_USER@$SILO_HOST:/etc/systemd/system/kidlisp-sidecar.service + +rm -f $TMP_ENV + +## Permission + restart +ssh -i $SSH_KEY $SILO_USER@$SILO_HOST " + chown datomic:datomic $REMOTE_DIR/kidlisp-sidecar.jar $REMOTE_DIR/.env + chmod 0600 $REMOTE_DIR/.env + systemctl daemon-reload + systemctl restart kidlisp-sidecar + sleep 2 + systemctl is-active kidlisp-sidecar +" +set STATUS $status +if test $STATUS -eq 0 + echo -e "$GREEN Sidecar restarted OK.$NC" +else + echo -e "$RED x Sidecar failed to start. Check:$NC" + echo -e "$YELLOW ssh -i $SSH_KEY $SILO_USER@$SILO_HOST journalctl -u kidlisp-sidecar -n 50$NC" + exit 1 +end + +echo -e "$GREEN Done.$NC" diff --git a/kidlisp-sidecar/deps.edn b/kidlisp-sidecar/deps.edn new file mode 100644 index 0000000000..61831ddb8d --- /dev/null +++ b/kidlisp-sidecar/deps.edn @@ -0,0 +1,35 @@ +{:paths ["src" "resources"] + :deps {org.clojure/clojure {:mvn/version "1.12.0"} + + ;; HTTP server + metosin/reitit {:mvn/version "0.7.2"} + metosin/muuntaja {:mvn/version "0.6.11"} + metosin/jsonista {:mvn/version "0.3.13"} + http-kit/http-kit {:mvn/version "2.8.0"} + ring/ring-core {:mvn/version "1.13.0"} + + ;; Datomic Pro (Apache 2.0) + com.datomic/peer {:mvn/version "1.0.7180"} + + ;; Postgres JDBC driver — required by the peer to read from SQL + ;; storage (and to register the driver with DriverManager when + ;; the datomic:sql://... URI is parsed). + org.postgresql/postgresql {:mvn/version "42.7.4"} + + ;; Logging + org.slf4j/slf4j-simple {:mvn/version "2.0.16"}} + + :aliases + {:run {:main-opts ["-m" "ac.kidlisp.core"]} + + :uberjar {:deps {com.github.seancorfield/depstar {:mvn/version "2.1.303"}} + :replace-paths [] + :replace-deps {com.github.clj-easy/graal-build-time + {:mvn/version "1.0.5"}} + :exec-fn hf.depstar/uberjar + :exec-args {:jar "target/kidlisp-sidecar.jar" + :aot true + :main-class ac.kidlisp.core}} + + :dev {:extra-deps {nrepl/nrepl {:mvn/version "1.3.0"}} + :main-opts ["-m" "nrepl.cmdline" "--port" "7888"]}}} diff --git a/kidlisp-sidecar/kidlisp-sidecar.service b/kidlisp-sidecar/kidlisp-sidecar.service new file mode 100644 index 0000000000..bb87a8deb2 --- /dev/null +++ b/kidlisp-sidecar/kidlisp-sidecar.service @@ -0,0 +1,24 @@ +[Unit] +Description=kidlisp-sidecar (Datomic bridge for Aesthetic Computer) +After=network.target datomic-transactor.service +Requires=datomic-transactor.service + +[Service] +Type=simple +User=datomic +Group=datomic +WorkingDirectory=/opt/kidlisp-sidecar +EnvironmentFile=/opt/kidlisp-sidecar/.env +## Runs directly from the checked-out source via Clojure CLI. Deps are +## resolved on first start and cached in ~/.m2 for subsequent restarts. +ExecStart=/usr/local/bin/clojure -J-Xmx256m -J-Xms128m -M -m ac.kidlisp.core +Environment=HOME=/opt/kidlisp-sidecar +Restart=on-failure +RestartSec=5 +StandardOutput=journal +StandardError=journal + +LimitNOFILE=65536 + +[Install] +WantedBy=multi-user.target diff --git a/kidlisp-sidecar/src/ac/kidlisp/admin.clj b/kidlisp-sidecar/src/ac/kidlisp/admin.clj new file mode 100644 index 0000000000..40d085ebdb --- /dev/null +++ b/kidlisp-sidecar/src/ac/kidlisp/admin.clj @@ -0,0 +1,210 @@ +(ns ac.kidlisp.admin + "Read-only admin surface consumed by the silo dashboard via the silo server. + v1 is strictly read-only: no transact, no retract, no write surface at all." + (:require [datomic.api :as d] + [clojure.edn :as edn] + [clojure.java.io :as io] + [clojure.string :as str])) + +(defn- ok [body] {:status 200 :body body}) +(defn- bad [msg] {:status 400 :body {:error msg}}) + +(defn schema + "GET /admin/schema — attribute catalog (only :kidlisp/ :keep/ :tezos/ + :rebake/ :ipfs/ :user/ idents; filters out system attributes)." + [conn] + (fn [_req] + (let [db (d/db conn) + our? (fn [kw] + (contains? #{"kidlisp" "keep" "tezos" "rebake" "ipfs" "user" "mint"} + (namespace kw))) + attrs (d/q '[:find [?ident ...] + :where [?e :db/ident ?ident]] + db) + rows (for [ident attrs + :when (and (keyword? ident) (our? ident)) + :let [e (d/entity db ident)]] + {:ident ident + :valueType (:db/valueType e) + :cardinality (:db/cardinality e) + :unique (:db/unique e) + :indexed (boolean (:db/index e)) + :isComponent (boolean (:db/isComponent e)) + :noHistory (boolean (:db/noHistory e)) + :doc (:db/doc e)})] + (ok {:attributes (vec (sort-by :ident rows))})))) + +(defn stats + "GET /admin/stats — entity counts per type + recent tx rate." + [conn] + (fn [_req] + (let [db (d/db conn) + kidlisp (ffirst (d/q '[:find (count ?e) :where [?e :kidlisp/code]] db)) + users (ffirst (d/q '[:find (count ?e) :where [?e :user/sub]] db)) + keeps (ffirst (d/q '[:find (count ?e) :where [?e :keep/token-id]] db)) + tx-last-hour + (ffirst (d/q '[:find (count ?tx) + :in $ ?since + :where + [?tx :db/txInstant ?inst] + [(> ?inst ?since)]] + db + (java.util.Date. (- (System/currentTimeMillis) (* 60 60 1000)))))] + (ok {:entityCounts {:kidlisp kidlisp + :users users + :keeps keeps} + :txLastHour tx-last-hour + :basisT (d/basis-t db)})))) + +(defn list-entities + "GET /admin/entities/:type?limit=&offset= + Supports :type = kidlisp | user | keep." + [conn] + (fn [req] + (let [typ (get-in req [:path-params :type]) + {:strs [limit offset]} (:query-params req) + limit (max 1 (min 1000 (Integer/parseInt (or limit "50")))) + offset (max 0 (Integer/parseInt (or offset "0"))) + db (d/db conn) + q (case typ + "kidlisp" '[:find [?e ...] :where [?e :kidlisp/code]] + "user" '[:find [?e ...] :where [?e :user/sub]] + "keep" '[:find [?e ...] :where [?e :keep/token-id]] + nil)] + (if-not q + (bad (str "unknown type: " typ)) + (let [all (vec (sort (d/q q db))) + page (->> all (drop offset) (take limit)) + rows (mapv (fn [eid] + (let [e (d/entity db eid)] + (into {:db/id eid} e))) + page)] + (ok {:type typ + :total (count all) + :offset offset + :limit limit + :items rows})))))) + +(defn entity + "GET /admin/entity/:eid — current facts." + [conn] + (fn [req] + (let [eid (Long/parseLong (get-in req [:path-params :eid])) + db (d/db conn) + e (d/entity db eid)] + (if e + (ok (into {:db/id eid} e)) + {:status 404 :body {:error "not-found"}})))) + +(defn entity-history + "GET /admin/entity/:eid/history — all facts ever asserted about this + entity, with tx timestamp and add/retract flag." + [conn] + (fn [req] + (let [eid (Long/parseLong (get-in req [:path-params :eid])) + db (d/db conn) + rows (d/q '[:find ?a ?v ?tx ?inst ?added + :in $ ?e + :where + [?e ?a ?v ?tx ?added] + [?tx :db/txInstant ?inst]] + (d/history db) eid) + by-tx (sort-by #(nth % 3) rows)] + (ok {:eid eid + :history (mapv (fn [[a v tx inst added]] + {:attr (d/ident db a) + :value (if (keyword? v) v (str v)) + :tx tx + :at inst + :added added}) + by-tx)})))) + +(defn tx-log + "GET /admin/tx-log?limit=&since= + Recent transactions with summary of assertions/retractions." + [conn] + (fn [req] + (let [{:strs [limit since]} (:query-params req) + limit (max 1 (min 1000 (Integer/parseInt (or limit "50")))) + db (d/db conn) + since-inst (when (seq since) + (java.util.Date/from (java.time.Instant/parse since))) + rows (d/q (if since-inst + '[:find ?tx ?inst + :in $ ?since + :where + [?tx :db/txInstant ?inst] + [(> ?inst ?since)]] + '[:find ?tx ?inst + :where + [?tx :db/txInstant ?inst]]) + db (or since-inst (java.util.Date. 0))) + recent (->> rows (sort-by second #(compare %2 %1)) (take limit))] + (ok {:transactions + (mapv (fn [[tx inst]] + {:tx tx + :at inst}) + recent)})))) + +(defn- safe-query? + "Ultra-conservative read-only check on a datalog query edn string. + Rejects transact/retract/with/apply-tx/io-rsrc forms and anything + mentioning `:db/add` or `:db/retract`. Intentionally strict." + [q-str] + (and (string? q-str) + (not (re-find #"(?i)\b(transact|retract|with|d/with|db/add|db/retract|d/transact|io-rsrc)\b" q-str)))) + +(defn query + "POST /admin/query — body: {query (edn string), args (vec)} + Runs against (d/db conn) only. Results capped at 10k rows + 5s timeout." + [conn] + (fn [req] + (let [{:keys [query args]} (:body-params req)] + (if-not (safe-query? query) + (bad "query rejected (read-only policy)") + (try + (let [parsed (edn/read-string query) + db (d/db conn) + fut (future (d/q parsed db (or args []))) + result (deref fut 5000 ::timeout)] + (cond + (= result ::timeout) + (do (future-cancel fut) + {:status 408 :body {:error "query timed out (5s)"}}) + + :else + (ok {:count (count result) + :rows (->> result (take 10000) vec) + :truncated (> (count result) 10000)}))) + (catch Throwable t + {:status 500 :body {:error (.getMessage t)}})))))) + +(defn backups + "GET /admin/backups — lists pg_dump files in /var/backups/datomic." + [_conn] + (fn [_req] + (let [dir (io/file "/var/backups/datomic") + files (when (.isDirectory dir) + (->> (.listFiles dir) + (filter #(str/ends-with? (.getName ^java.io.File %) ".sql.gz")) + (sort-by #(.lastModified ^java.io.File %) >) + (take 30) + (map (fn [^java.io.File f] + {:name (.getName f) + :size (.length f) + :at (java.util.Date. (.lastModified f))}))))] + (ok {:backups (vec files)})))) + +(defn health + "GET /admin/health — transactor reachable, schema present." + [conn] + (fn [_req] + (try + (let [db (d/db conn) + schema-ok? (some? (d/entid db :kidlisp/code))] + (ok {:transactor true + :schema schema-ok? + :basisT (d/basis-t db)})) + (catch Throwable t + {:status 500 :body {:transactor false + :error (.getMessage t)}})))) diff --git a/kidlisp-sidecar/src/ac/kidlisp/auth.clj b/kidlisp-sidecar/src/ac/kidlisp/auth.clj new file mode 100644 index 0000000000..cdbff9373b --- /dev/null +++ b/kidlisp-sidecar/src/ac/kidlisp/auth.clj @@ -0,0 +1,26 @@ +(ns ac.kidlisp.auth + "Shared-secret middleware. Two separate secrets: + CLIENT_SECRET — used by AC Netlify functions hitting /kidlisp/* + ADMIN_SECRET — used only by silo server hitting /admin/* + Keeping them separate means compromising the client secret cannot also + read admin-level data (history, tx log, arbitrary datalog).") + +(defn- env [k] + (System/getenv k)) + +(defn- check-header [req secret] + (= (get-in req [:headers "x-sidecar-secret"]) secret)) + +(defn client-secret-middleware [] + (fn [handler] + (fn [req] + (if (check-header req (env "CLIENT_SECRET")) + (handler req) + {:status 401 :body {:error "unauthorized"}})))) + +(defn admin-secret-middleware [] + (fn [handler] + (fn [req] + (if (check-header req (env "ADMIN_SECRET")) + (handler req) + {:status 401 :body {:error "unauthorized"}})))) diff --git a/kidlisp-sidecar/src/ac/kidlisp/core.clj b/kidlisp-sidecar/src/ac/kidlisp/core.clj new file mode 100644 index 0000000000..c4e1bb42ab --- /dev/null +++ b/kidlisp-sidecar/src/ac/kidlisp/core.clj @@ -0,0 +1,67 @@ +(ns ac.kidlisp.core + (:require [org.httpkit.server :as http] + [reitit.ring :as ring] + [reitit.ring.middleware.muuntaja :as muuntaja-mw] + [muuntaja.core :as m] + [ac.kidlisp.db :as db] + [ac.kidlisp.schema :as schema] + [ac.kidlisp.handlers :as h] + [ac.kidlisp.admin :as admin] + [ac.kidlisp.auth :as auth]) + (:gen-class)) + +(defn- env [k default] + (or (System/getenv k) default)) + +(defn- app-router [conn] + (ring/ring-handler + (ring/router + [["/health" + {:get (fn [_] {:status 200 :body {:ok true}})}] + + ;; ───── Public kidlisp API (called by AC backend) ───── + ["/kidlisp" + {:middleware [(auth/client-secret-middleware)]} + ["" {:post (h/create conn) + :get (h/list-codes conn)}] + ["/lookup" {:post (h/batch-lookup conn)}] + ["/stats/functions" {:get (h/stats-functions conn)}] + ["/hash/:hash" {:get (h/lookup-hash conn)}] + ["/:code" {:get (h/lookup-code conn)}] + ["/:code/mint" {:post (h/record-mint conn)}] + ["/:code/tezos-state" {:post (h/set-tezos-state conn)}] + ["/:code/pending-rebake" {:post (h/set-pending-rebake conn)}] + ["/:code/ipfs-media" {:post (h/set-ipfs-media conn)}] + ["/:code/atproto-rkey" {:post (h/set-atproto-rkey conn)}] + ["/:code/lineage" {:get (h/lineage conn)}]] + + ;; ───── Admin surface (silo-only, read-only in v1) ───── + ["/admin" + {:middleware [(auth/admin-secret-middleware)]} + ["/schema" {:get (admin/schema conn)}] + ["/stats" {:get (admin/stats conn)}] + ["/entities/:type" {:get (admin/list-entities conn)}] + ["/entity/:eid" {:get (admin/entity conn)}] + ["/entity/:eid/history" {:get (admin/entity-history conn)}] + ["/tx-log" {:get (admin/tx-log conn)}] + ["/query" {:post (admin/query conn)}] + ["/backups" {:get (admin/backups conn)}] + ["/health" {:get (admin/health conn)}]]] + + ;; :conflicts nil disables reitit's strict conflict detector. Our + ;; overlaps are resolved either by static-segment precedence + ;; (e.g. /kidlisp/hash beats /kidlisp/:code) or by HTTP method + ;; (e.g. POST /kidlisp/lookup vs GET /kidlisp/:code). + {:conflicts nil + :data {:muuntaja m/instance + :middleware [muuntaja-mw/format-middleware]}}) + (ring/create-default-handler))) + +(defn -main [& _] + (let [uri (env "DATOMIC_URI" + "datomic:sql://kidlisp?jdbc:postgresql://localhost:5432/datomic") + port (Integer/parseInt (env "PORT" "8891")) + conn (db/connect uri)] + (schema/ensure! conn) + (http/run-server (app-router conn) {:port port :ip "127.0.0.1"}) + (println (str "kidlisp-sidecar listening on 127.0.0.1:" port)))) diff --git a/kidlisp-sidecar/src/ac/kidlisp/db.clj b/kidlisp-sidecar/src/ac/kidlisp/db.clj new file mode 100644 index 0000000000..2547ec61db --- /dev/null +++ b/kidlisp-sidecar/src/ac/kidlisp/db.clj @@ -0,0 +1,15 @@ +(ns ac.kidlisp.db + (:require [datomic.api :as d])) + +(defn connect + "Create database if missing, return a connection. + URI is the full Datomic URI including storage protocol + db name, + e.g. datomic:sql://kidlisp?jdbc:postgresql://localhost:5432/datomic" + [uri] + (d/create-database uri) + (d/connect uri)) + +(defn db [conn] (d/db conn)) + +(defn transact [conn tx-data] + @(d/transact conn tx-data)) diff --git a/kidlisp-sidecar/src/ac/kidlisp/handlers.clj b/kidlisp-sidecar/src/ac/kidlisp/handlers.clj new file mode 100644 index 0000000000..c40d6928d3 --- /dev/null +++ b/kidlisp-sidecar/src/ac/kidlisp/handlers.clj @@ -0,0 +1,409 @@ +(ns ac.kidlisp.handlers + "Public kidlisp endpoints called by the AC backend (Netlify functions). + The external Mongo-era response shape is preserved by the Node compat + layer (system/netlify/functions/store-kidlisp.mjs); this sidecar returns + clean, Datomic-native shapes." + (:require [datomic.api :as d] + [ac.kidlisp.db :as db])) + +;; ─────────────────── helpers ─────────────────── + +(defn- ok [body] {:status 200 :body body}) +(defn- created [body] {:status 201 :body body}) +(defn- bad [msg] {:status 400 :body {:error msg}}) +(defn- not-found [] {:status 404 :body {:error "not-found"}}) + +(defn- now-inst [] (java.util.Date.)) + +(defn- ->user-ref + "Upserts a user entity by sub and returns a lookup ref usable in a + following tx data map." + [sub] + (when sub [:user/sub sub])) + +(defn- piece->map + "Entity -> API response map. Pulls component children as well." + [e] + (let [m (into {} e)] + (cond-> {:code (:kidlisp/code m) + :hash (:kidlisp/hash m) + :source (:kidlisp/source m) + :when (:kidlisp/created-at m) + :lastAccessed (:kidlisp/last-accessed m) + :hits (or (:kidlisp/hits m) 0) + :user (get-in m [:kidlisp/author :user/sub]) + :atproto (when-let [rk (:kidlisp/atproto-rkey m)] + {:rkey rk})} + (:kidlisp/ipfs-media m) + (assoc :ipfsMedia + (let [im (:kidlisp/ipfs-media m)] + {:artifactUri (:ipfs/artifact-uri im) + :thumbnailUri (:ipfs/thumbnail-uri im) + :sourceHash (:ipfs/source-hash im) + :createdAt (:ipfs/created-at im) + :authorHandle (:ipfs/author-handle im) + :depCount (:ipfs/dep-count im) + :packDate (:ipfs/pack-date im)})) + + (seq (:kidlisp/keeps m)) + (assoc :keeps + (mapv (fn [k] + {:tokenId (:keep/token-id k) + :network (:keep/network k) + :txHash (:keep/tx-hash k) + :contractAddress (:keep/contract-address k) + :contractProfile (:keep/contract-profile k) + :contractVersion (:keep/contract-version k) + :keptAt (:keep/kept-at k) + :keptBy (:keep/kept-by k) + :walletAddress (:keep/wallet-address k) + :artifactUri (:keep/artifact-uri k) + :thumbnailUri (:keep/thumbnail-uri k) + :metadataUri (:keep/metadata-uri k) + :source (:keep/source k)}) + (:kidlisp/keeps m))) + + (:kidlisp/tezos-state m) + (assoc :tezos + (let [t (:kidlisp/tezos-state m)] + {:minted (:tezos/minted t) + :exists (:tezos/exists t) + :tokenId (:tezos/token-id t) + :txHash (:tezos/tx-hash t) + :creatorAddress (:tezos/creator-address t) + :codeHash (:tezos/code-hash t) + :network (:tezos/network t) + :mintedAt (:tezos/minted-at t) + :checkedAt (:tezos/checked-at t) + :attemptedAt (:tezos/attempted-at t) + :failedAt (:tezos/failed-at t) + :reason (:tezos/reason t) + :error (:tezos/error t)})) + + (:kidlisp/pending-rebake m) + (assoc :pendingRebake + (let [r (:kidlisp/pending-rebake m)] + {:artifactUri (:rebake/artifact-uri r) + :thumbnailUri (:rebake/thumbnail-uri r) + :metadataUri (:rebake/metadata-uri r) + :createdAt (:rebake/created-at r) + :contractAddress (:rebake/contract-address r) + :contractProfile (:rebake/contract-profile r) + :contractVersion (:rebake/contract-version r)}))))) + +(defn- entity-by-code [db code] + (when-let [eid (d/entid db [:kidlisp/code code])] + (d/entity db eid))) + +;; ─────────────────── handlers ─────────────────── + +(defn- parse-inst [v] + (cond + (inst? v) v + (string? v) (java.util.Date/from (java.time.Instant/parse v)) + (number? v) (java.util.Date. (long v)) + :else nil)) + +(defn create + "POST /kidlisp + body: {source, hash, code, user_sub?, forked_from?, when?, hits?} + Dedup by hash: if an entity with the given hash exists, bump hits and + return its existing code. Otherwise insert with the proposed code. + + `when` and `hits` are optional — present during backfill so historical + timestamps and hit counts are preserved. Absent during normal writes, + in which case server time / hits=1 is used." + [conn] + (fn [req] + (let [{:keys [source hash code user_sub forked_from when hits]} + (:body-params req)] + (if (or (nil? source) (nil? hash) (nil? code)) + (bad "source, hash, code are required") + (let [db (d/db conn)] + (if-let [existing-eid (d/entid db [:kidlisp/hash hash])] + (let [existing (d/entity db existing-eid)] + (db/transact conn + [[:db/add existing-eid :kidlisp/hits + (inc (or (:kidlisp/hits existing) 0))] + [:db/add existing-eid :kidlisp/last-accessed + (now-inst)]]) + (ok {:code (:kidlisp/code existing) :cached true})) + (let [created-at (or (parse-inst when) (now-inst)) + piece-tx + (cond-> {:kidlisp/code code + :kidlisp/hash hash + :kidlisp/source source + :kidlisp/created-at created-at + :kidlisp/last-accessed created-at + :kidlisp/hits (or hits 1)} + user_sub + (assoc :kidlisp/author {:user/sub user_sub}) + + forked_from + (assoc :kidlisp/forked-from [:kidlisp/code forked_from]))] + (db/transact conn [piece-tx]) + (created {:code code :cached false})))))))) + +(defn lookup-code + "GET /kidlisp/:code — returns full entity, increments hits." + [conn] + (fn [req] + (let [code (get-in req [:path-params :code]) + db (d/db conn)] + (if-let [e (entity-by-code db code)] + (do + (db/transact conn + [[:db/add (:db/id e) :kidlisp/hits + (inc (or (:kidlisp/hits e) 0))] + [:db/add (:db/id e) :kidlisp/last-accessed + (now-inst)]]) + (ok (piece->map e))) + (not-found))))) + +(defn lookup-hash + "GET /kidlisp/hash/:hash — dedup lookup (does not increment hits)." + [conn] + (fn [req] + (let [hsh (get-in req [:path-params :hash]) + db (d/db conn)] + (if-let [eid (d/entid db [:kidlisp/hash hsh])] + (ok (piece->map (d/entity db eid))) + (not-found))))) + +(defn batch-lookup + "POST /kidlisp/lookup + body: {codes: [...]} + Returns {results: {code -> entity|null}, summary: {...}} + Increments hits for found codes." + [conn] + (fn [req] + (let [codes (get-in req [:body-params :codes])] + (if-not (and (sequential? codes) (seq codes)) + (bad "codes must be a non-empty array") + (let [db (d/db conn) + found (into {} (for [c codes + :let [e (entity-by-code db c)] + :when e] + [c (piece->map e)])) + missing (vec (remove found codes)) + tx (for [c (keys found) + :let [e (entity-by-code db c)]] + [:db/add (:db/id e) :kidlisp/hits + (inc (or (:kidlisp/hits e) 0))])] + (when (seq tx) (db/transact conn (vec tx))) + (ok {:results (merge (into {} (for [c missing] [c nil])) found) + :summary {:requested (count codes) + :found (count found) + :missing (count missing) + :foundCodes (vec (keys found)) + :missingCodes missing}})))))) + +(defn list-codes + "GET /kidlisp?since=...&limit=...&sort=recent|hits&handle=...&codes=... + Returns {recent: [...], count, limit}. `handle` filter matched against + the author's handle — but this sidecar does not store handles; the + Node compat layer joins @handles from Mongo server-side." + [conn] + (fn [req] + (let [{:strs [limit sort since]} (:query-params req) + limit (min 100000 (max 1 (Integer/parseInt (or limit "50")))) + db (d/db conn) + since-inst (when (seq since) (java.util.Date/from (java.time.Instant/parse since))) + q (if since-inst + '[:find [?e ...] + :in $ ?since + :where + [?e :kidlisp/created-at ?when] + [(> ?when ?since)]] + '[:find [?e ...] + :where + [?e :kidlisp/code]]) + eids (if since-inst (d/q q db since-inst) (d/q q db)) + pieces (->> eids + (map #(d/entity db %)) + (sort-by (case sort + "hits" #(- (or (:kidlisp/hits %) 0)) + #(- (.getTime ^java.util.Date (:kidlisp/created-at %))))) + (take limit) + (map piece->map))] + (ok {:recent (vec pieces) + :count (count pieces) + :limit limit})))) + +(defn stats-functions + "GET /kidlisp/stats/functions?limit=5000 + Corpus-wide aggregation: scans top-N pieces by hits and tallies + function-call usage. Implementation mirrors the logic in the existing + store-kidlisp.mjs handler. For v1 we return raw (code, source, hits) + tuples and let the Node compat layer do the tallying — keeps the + sidecar simple and reuses the existing JS tokenizer regex." + [conn] + (fn [req] + (let [{:strs [limit]} (:query-params req) + limit (min 100000 (Integer/parseInt (or limit "5000"))) + db (d/db conn) + rows (d/q '[:find ?src ?hits + :where + [?e :kidlisp/source ?src] + [?e :kidlisp/hits ?hits]] + db)] + (ok {:docs (->> rows + (sort-by second >) + (take limit) + (map (fn [[src hits]] {:source src :hits hits})))})))) + +(defn- update-piece + "Shared utility: set multi-attribute component entity on a piece by code. + `sub-attrs` is a map of sub-attribute (e.g. :keep/token-id) -> value. + `parent-attr` is the ref attribute on the piece (e.g. :kidlisp/keeps). + `cardinality` is :one or :many." + [conn code parent-attr cardinality sub-attrs] + (let [db (d/db conn)] + (if-let [piece-eid (d/entid db [:kidlisp/code code])] + (let [new-eid (d/tempid :db.part/user) + ent-map (assoc sub-attrs :db/id new-eid) + op (if (= cardinality :many) + [:db/add piece-eid parent-attr new-eid] + [:db/add piece-eid parent-attr new-eid])] + (db/transact conn [ent-map op]) + true) + false))) + +(defn record-mint + "POST /kidlisp/:code/mint — appends a keep record." + [conn] + (fn [req] + (let [code (get-in req [:path-params :code]) + {:keys [tokenId network txHash contractAddress contractProfile + contractVersion keptAt keptBy walletAddress artifactUri + thumbnailUri metadataUri source]} + (:body-params req)] + (if (and tokenId contractAddress) + (if (update-piece conn code :kidlisp/keeps :many + (cond-> {} + tokenId (assoc :keep/token-id tokenId) + network (assoc :keep/network network) + txHash (assoc :keep/tx-hash txHash) + contractAddress (assoc :keep/contract-address contractAddress) + contractProfile (assoc :keep/contract-profile contractProfile) + contractVersion (assoc :keep/contract-version contractVersion) + keptAt (assoc :keep/kept-at (java.util.Date/from + (java.time.Instant/parse keptAt))) + keptBy (assoc :keep/kept-by keptBy) + walletAddress (assoc :keep/wallet-address walletAddress) + artifactUri (assoc :keep/artifact-uri artifactUri) + thumbnailUri (assoc :keep/thumbnail-uri thumbnailUri) + metadataUri (assoc :keep/metadata-uri metadataUri) + source (assoc :keep/source source))) + (ok {:ok true}) + (not-found)) + (bad "tokenId and contractAddress required"))))) + +(defn- merge-component + "Replaces-or-creates a cardinality/one component. Sub-attrs are keyed by + Datomic keyword; nil values are skipped." + [conn code parent-attr sub-attrs] + (let [db (d/db conn)] + (if-let [piece-eid (d/entid db [:kidlisp/code code])] + (let [cleaned (into {} (remove (comp nil? val) sub-attrs)) + tx (if (seq cleaned) + [(assoc cleaned :db/id "new") + [:db/add piece-eid parent-attr "new"]] + [])] + (when (seq tx) (db/transact conn tx)) + true) + false))) + +(defn set-tezos-state + "POST /kidlisp/:code/tezos-state — replaces the legacy tezos summary." + [conn] + (fn [req] + (let [code (get-in req [:path-params :code]) + b (:body-params req)] + (if (merge-component conn code :kidlisp/tezos-state + {:tezos/minted (:minted b) + :tezos/exists (:exists b) + :tezos/token-id (:tokenId b) + :tezos/tx-hash (:txHash b) + :tezos/creator-address (:creatorAddress b) + :tezos/code-hash (:codeHash b) + :tezos/network (:network b) + :tezos/reason (:reason b) + :tezos/error (:error b)}) + (ok {:ok true}) + (not-found))))) + +(defn set-pending-rebake + "POST /kidlisp/:code/pending-rebake — replaces the pending rebake blob." + [conn] + (fn [req] + (let [code (get-in req [:path-params :code]) + b (:body-params req)] + (if (merge-component conn code :kidlisp/pending-rebake + {:rebake/artifact-uri (:artifactUri b) + :rebake/thumbnail-uri (:thumbnailUri b) + :rebake/metadata-uri (:metadataUri b) + :rebake/contract-address (:contractAddress b) + :rebake/contract-profile (:contractProfile b) + :rebake/contract-version (:contractVersion b)}) + (ok {:ok true}) + (not-found))))) + +(defn set-ipfs-media + "POST /kidlisp/:code/ipfs-media — replaces the IPFS bundle cache." + [conn] + (fn [req] + (let [code (get-in req [:path-params :code]) + b (:body-params req)] + (if (merge-component conn code :kidlisp/ipfs-media + {:ipfs/artifact-uri (:artifactUri b) + :ipfs/thumbnail-uri (:thumbnailUri b) + :ipfs/source-hash (:sourceHash b) + :ipfs/author-handle (:authorHandle b) + :ipfs/dep-count (:depCount b)}) + (ok {:ok true}) + (not-found))))) + +(defn set-atproto-rkey + "POST /kidlisp/:code/atproto-rkey — records the Bluesky record key." + [conn] + (fn [req] + (let [code (get-in req [:path-params :code]) + rkey (get-in req [:body-params :rkey]) + db (d/db conn)] + (if-let [eid (d/entid db [:kidlisp/code code])] + (do (db/transact conn [[:db/add eid :kidlisp/atproto-rkey rkey]]) + (ok {:ok true})) + (not-found))))) + +(defn lineage + "GET /kidlisp/:code/lineage — returns {ancestors, descendants} as + chains of {code, author}. Ancestors walks :kidlisp/forked-from up, + descendants uses a reverse lookup." + [conn] + (fn [req] + (let [code (get-in req [:path-params :code]) + db (d/db conn)] + (if-let [eid (d/entid db [:kidlisp/code code])] + (let [ancestors + (loop [cur eid acc []] + (let [e (d/entity db cur) + parent (:kidlisp/forked-from e)] + (if parent + (recur (:db/id parent) + (conj acc {:code (:kidlisp/code parent) + :author (get-in parent [:kidlisp/author :user/sub])})) + acc))) + descendants + (vec (d/q '[:find ?code ?sub + :in $ ?root + :where + [?c :kidlisp/forked-from ?root] + [?c :kidlisp/code ?code] + [?c :kidlisp/author ?a] + [?a :user/sub ?sub]] + db eid))] + (ok {:root code + :ancestors ancestors + :descendants (mapv (fn [[c s]] {:code c :author s}) descendants)})) + (not-found))))) diff --git a/kidlisp-sidecar/src/ac/kidlisp/schema.clj b/kidlisp-sidecar/src/ac/kidlisp/schema.clj new file mode 100644 index 0000000000..1499bdf771 --- /dev/null +++ b/kidlisp-sidecar/src/ac/kidlisp/schema.clj @@ -0,0 +1,239 @@ +(ns ac.kidlisp.schema + "Datomic schema for kidlisp v1. Covers every field that the existing + store-kidlisp.mjs currently persists in the Mongo `kidlisp` collection, + so that 'zero Mongo writes for kidlisp' is actually achievable. + + Keep records and mint/attempt events are modeled as their own entities + referenced via :kidlisp/keeps and :kidlisp/mint-attempts. Legacy Tezos + state lives alongside for migration fidelity." + (:require [datomic.api :as d])) + +(def schema-v1 + [;; ───────── user ───────── + {:db/ident :user/sub + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one + :db/unique :db.unique/identity + :db/doc "Auth0 subject identifier for the author."} + + ;; ───────── kidlisp piece ───────── + {:db/ident :kidlisp/code + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one + :db/unique :db.unique/identity + :db/doc "Nanoid slug — the $code a user types."} + + {:db/ident :kidlisp/hash + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one + :db/unique :db.unique/identity + :db/doc "SHA-256 of trimmed source. Unique: dedup."} + + {:db/ident :kidlisp/source + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one + :db/doc "Source code text."} + + {:db/ident :kidlisp/author + :db/valueType :db.type/ref + :db/cardinality :db.cardinality/one + :db/doc "Ref to :user/sub entity. Nullable (anonymous caches)."} + + {:db/ident :kidlisp/created-at + :db/valueType :db.type/instant + :db/cardinality :db.cardinality/one + :db/index true + :db/doc "Mirrors existing Mongo `when` field."} + + {:db/ident :kidlisp/last-accessed + :db/valueType :db.type/instant + :db/cardinality :db.cardinality/one + :db/noHistory true + :db/doc "Updated on every GET. :db/noHistory prevents the tx + log from filling with access events — history queries + won't see past values, only the current one. v2 will + migrate this to Redis entirely."} + + {:db/ident :kidlisp/hits + :db/valueType :db.type/long + :db/cardinality :db.cardinality/one + :db/noHistory true + :db/doc "Access counter. :db/noHistory for same reason as + :kidlisp/last-accessed."} + + {:db/ident :kidlisp/forked-from + :db/valueType :db.type/ref + :db/cardinality :db.cardinality/one + :db/doc "Parent piece ref — enables lineage queries."} + + ;; ───────── ATProto sync ───────── + {:db/ident :kidlisp/atproto-rkey + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one + :db/doc "Bluesky record key after mirror-to-PDS completes."} + + ;; ───────── IPFS media (bundle cache) ───────── + {:db/ident :kidlisp/ipfs-media + :db/valueType :db.type/ref + :db/cardinality :db.cardinality/one + :db/isComponent true + :db/doc "Component entity: cached IPFS artifacts."} + + {:db/ident :ipfs/artifact-uri + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one} + {:db/ident :ipfs/thumbnail-uri + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one} + {:db/ident :ipfs/source-hash + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one} + {:db/ident :ipfs/created-at + :db/valueType :db.type/instant + :db/cardinality :db.cardinality/one} + {:db/ident :ipfs/author-handle + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one} + {:db/ident :ipfs/dep-count + :db/valueType :db.type/long + :db/cardinality :db.cardinality/one} + {:db/ident :ipfs/pack-date + :db/valueType :db.type/instant + :db/cardinality :db.cardinality/one} + + ;; ───────── Keep records (plural; contract-keyed) ───────── + {:db/ident :kidlisp/keeps + :db/valueType :db.type/ref + :db/cardinality :db.cardinality/many + :db/isComponent true + :db/doc "Zero or more on-chain keep/mint records, one per + contract+tokenId+network combination."} + + {:db/ident :keep/token-id + :db/valueType :db.type/long + :db/cardinality :db.cardinality/one + :db/index true} + {:db/ident :keep/network + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one} + {:db/ident :keep/tx-hash + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one} + {:db/ident :keep/contract-address + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one + :db/index true} + {:db/ident :keep/contract-profile + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one} + {:db/ident :keep/contract-version + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one} + {:db/ident :keep/kept-at + :db/valueType :db.type/instant + :db/cardinality :db.cardinality/one} + {:db/ident :keep/kept-by + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one} + {:db/ident :keep/wallet-address + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one} + {:db/ident :keep/artifact-uri + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one} + {:db/ident :keep/thumbnail-uri + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one} + {:db/ident :keep/metadata-uri + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one} + {:db/ident :keep/source + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one + :db/doc "Origin of the record: kept | legacy_tezos | contract_keyed | unknown"} + + ;; ───────── Legacy Tezos summary (single-piece field) ───────── + {:db/ident :kidlisp/tezos-state + :db/valueType :db.type/ref + :db/cardinality :db.cardinality/one + :db/isComponent true + :db/doc "Mirrors the current `tezos` object on Mongo docs — + mint-attempted/exists/error/skipped summary."} + + {:db/ident :tezos/minted + :db/valueType :db.type/boolean + :db/cardinality :db.cardinality/one} + {:db/ident :tezos/exists + :db/valueType :db.type/boolean + :db/cardinality :db.cardinality/one} + {:db/ident :tezos/token-id + :db/valueType :db.type/long + :db/cardinality :db.cardinality/one} + {:db/ident :tezos/tx-hash + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one} + {:db/ident :tezos/creator-address + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one} + {:db/ident :tezos/code-hash + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one} + {:db/ident :tezos/network + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one} + {:db/ident :tezos/minted-at + :db/valueType :db.type/instant + :db/cardinality :db.cardinality/one} + {:db/ident :tezos/checked-at + :db/valueType :db.type/instant + :db/cardinality :db.cardinality/one} + {:db/ident :tezos/attempted-at + :db/valueType :db.type/instant + :db/cardinality :db.cardinality/one} + {:db/ident :tezos/failed-at + :db/valueType :db.type/instant + :db/cardinality :db.cardinality/one} + {:db/ident :tezos/reason + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one} + {:db/ident :tezos/error + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one} + + ;; ───────── Pending rebake ───────── + {:db/ident :kidlisp/pending-rebake + :db/valueType :db.type/ref + :db/cardinality :db.cardinality/one + :db/isComponent true + :db/doc "State after a rebake that is not yet reflected on chain."} + + {:db/ident :rebake/artifact-uri + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one} + {:db/ident :rebake/thumbnail-uri + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one} + {:db/ident :rebake/metadata-uri + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one} + {:db/ident :rebake/created-at + :db/valueType :db.type/instant + :db/cardinality :db.cardinality/one} + {:db/ident :rebake/contract-address + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one} + {:db/ident :rebake/contract-profile + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one} + {:db/ident :rebake/contract-version + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one}]) + +(defn- schema-installed? [db] + (some? (d/entid db :kidlisp/code))) + +(defn ensure! + "Idempotently installs schema-v1 if not already present." + [conn] + (when-not (schema-installed? (d/db conn)) + @(d/transact conn schema-v1))) diff --git a/silo/dashboard.html b/silo/dashboard.html index 52d6aa2325..dd699f92ed 100644 --- a/silo/dashboard.html +++ b/silo/dashboard.html @@ -315,6 +315,7 @@ a:hover { text-decoration: underline; } +
| ident | +type | +card | +flags | +doc | +
|---|