mirror of
https://github.com/Permissionless-Software-Foundation/psf-memo.git
synced 2026-09-21 16:52:01 -07:00
339 lines
14 KiB
BlitzBasic
Executable File
339 lines
14 KiB
BlitzBasic
Executable File
#!/usr/bin/env bb
|
|
|
|
(ns swarm-handoff
|
|
(:require [babashka.fs :as fs]
|
|
[clojure.java.shell :refer [sh]]
|
|
[clojure.string :as str]))
|
|
|
|
(def usage-text
|
|
(str "Usage: swarm_handoff.sh <draft-file>\n\n"
|
|
"Draft formats:\n\n"
|
|
"type: git_handoff\n"
|
|
"to: <role>[,<role>...]\n"
|
|
"priority: NN\n"
|
|
"task: <short-stable-task-name>\n"
|
|
"commit: <10-char-commit-abbrev>\n\n"
|
|
"type: note\n"
|
|
"to: <role>[,<role>...]\n"
|
|
"priority: NN\n"
|
|
"message: <one line, max 80 chars>"))
|
|
|
|
(def reserved-fields #{"id" "from" "role" "recipient" "created_at" "enqueued_at" "dequeued_at" "completed_at"})
|
|
(def allowed-fields #{"type" "to" "priority" "task" "commit" "message"})
|
|
(def allowed-types #{"git_handoff" "note"})
|
|
|
|
(defn usage []
|
|
(binding [*out* *err*]
|
|
(println usage-text)))
|
|
|
|
(defn exit! [status message]
|
|
(binding [*out* *err*]
|
|
(when message
|
|
(println message)))
|
|
(System/exit status))
|
|
|
|
(defn command
|
|
([dir & args]
|
|
(let [result (apply sh (concat args [:dir (str dir)]))]
|
|
result)))
|
|
|
|
(defn git-root []
|
|
(let [result (command "." "git" "rev-parse" "--show-toplevel")]
|
|
(when (zero? (:exit result))
|
|
(str/trim (:out result)))))
|
|
|
|
(defn git-common-dir []
|
|
(let [result (command "." "git" "rev-parse" "--git-common-dir")]
|
|
(when (zero? (:exit result))
|
|
(let [path (str/trim (:out result))]
|
|
(if (fs/absolute? path)
|
|
(str (fs/path path))
|
|
(str (fs/absolutize path)))))))
|
|
|
|
(defn project-root []
|
|
(if-let [root (git-root)]
|
|
(if (fs/exists? (fs/path root ".swarmforge" "roles.tsv"))
|
|
root
|
|
(if-let [common (git-common-dir)]
|
|
(let [candidate (str (fs/parent common))]
|
|
(if (fs/exists? (fs/path candidate ".swarmforge" "roles.tsv"))
|
|
candidate
|
|
(exit! 1 "Cannot find SwarmForge project root")))
|
|
(exit! 1 "Cannot find SwarmForge project root")))
|
|
(exit! 1 "Cannot find SwarmForge project root")))
|
|
|
|
(defn roles-file []
|
|
(fs/path (project-root) ".swarmforge" "roles.tsv"))
|
|
|
|
(defn role-known? [role]
|
|
(some (fn [line]
|
|
(= role (first (str/split line #"\t"))))
|
|
(str/split-lines (slurp (str (roles-file))))))
|
|
|
|
(defn sender-role []
|
|
(if-let [role (not-empty (System/getenv "SWARMFORGE_ROLE"))]
|
|
role
|
|
(exit! 1 "Set SWARMFORGE_ROLE.")))
|
|
|
|
(defn state-dir []
|
|
(fs/path (System/getProperty "user.dir") ".swarmforge" "handoffs"))
|
|
|
|
(defn timestamp []
|
|
(.format java.time.format.DateTimeFormatter/ISO_INSTANT
|
|
(java.time.Instant/now)))
|
|
|
|
(defn id-timestamp []
|
|
(.format (java.time.format.DateTimeFormatter/ofPattern "yyyyMMdd'T'HHmmss'Z'")
|
|
(.atZone (java.time.Instant/now) java.time.ZoneOffset/UTC)))
|
|
|
|
(defn valid-priority? [priority]
|
|
(boolean (re-matches #"[0-9][0-9]" priority)))
|
|
|
|
(defn parse-draft [draft]
|
|
(loop [lines (str/split-lines (slurp (str draft)))
|
|
line-no 0
|
|
body-seen? false
|
|
headers {}
|
|
ordered []
|
|
errors []]
|
|
(if-let [line (first lines)]
|
|
(let [line-no (inc line-no)]
|
|
(cond
|
|
body-seen?
|
|
(recur (next lines) line-no body-seen? headers ordered
|
|
(cond-> errors
|
|
(not (str/blank? line))
|
|
(conj (format "Line %d: draft handoffs may contain headers only; payloads are generated by swarm_handoff.sh." line-no))))
|
|
|
|
(str/blank? line)
|
|
(recur (next lines) line-no true headers ordered errors)
|
|
|
|
(not (str/includes? line ": "))
|
|
(recur (next lines) line-no body-seen? headers ordered
|
|
(conj errors (format "Line %d: expected 'field: value'." line-no)))
|
|
|
|
:else
|
|
(let [[field value] (str/split line #": " 2)]
|
|
(cond
|
|
(or (str/blank? field) (str/blank? value))
|
|
(recur (next lines) line-no body-seen? headers ordered
|
|
(conj errors (format "Line %d: field and value must both be non-empty." line-no)))
|
|
|
|
(reserved-fields field)
|
|
(recur (next lines) line-no body-seen? headers ordered
|
|
(conj errors (format "Line %d: header '%s' is reserved and must not be written by agents." line-no field)))
|
|
|
|
(not (allowed-fields field))
|
|
(recur (next lines) line-no body-seen? headers ordered
|
|
(conj errors (format "Line %d: unknown header '%s'." line-no field)))
|
|
|
|
(contains? headers field)
|
|
(recur (next lines) line-no body-seen? headers ordered
|
|
(conj errors (format "Line %d: duplicate header '%s'." line-no field)))
|
|
|
|
:else
|
|
(recur (next lines) line-no body-seen? (assoc headers field value) (conj ordered field) errors)))))
|
|
{:headers headers :ordered ordered :errors errors})))
|
|
|
|
(defn validate-recipients [to]
|
|
(if (str/blank? to)
|
|
[[] []]
|
|
(let [recipients (str/split to #"," -1)]
|
|
[recipients
|
|
(loop [remaining recipients seen #{} errors []]
|
|
(if-let [recipient (first remaining)]
|
|
(let [errors (cond-> errors
|
|
(str/blank? recipient)
|
|
(conj "Header 'to' contains an empty recipient.")
|
|
(str/includes? recipient "_")
|
|
(conj (format "Recipient role '%s' is invalid; role names may not contain underscores." recipient))
|
|
(contains? seen recipient)
|
|
(conj (format "Duplicate recipient '%s'." recipient))
|
|
(and (not (str/blank? recipient)) (not (role-known? recipient)))
|
|
(conj (format "Unknown recipient role '%s'." recipient)))]
|
|
(recur (next remaining) (conj seen recipient) errors))
|
|
errors))])))
|
|
|
|
(defn canonical-commit [commit]
|
|
(let [matches (-> (command "." "git" "rev-parse" (str "--disambiguate=" commit))
|
|
:out
|
|
str/split-lines
|
|
vec)]
|
|
(cond
|
|
(not= 1 (count matches))
|
|
[nil (format "Header 'commit' must resolve to exactly one Git object; '%s' matched %d." commit (count matches))]
|
|
|
|
:else
|
|
(let [object (first matches)
|
|
object-type (str/trim (:out (command "." "git" "cat-file" "-t" object)))]
|
|
(if (= "commit" object-type)
|
|
[(str/trim (:out (command "." "git" "rev-parse" "--short=10" object))) nil]
|
|
[nil (format "Header 'commit' must resolve to a commit; '%s' resolves to '%s'." commit object-type)])))))
|
|
|
|
(defn validate [headers ordered]
|
|
(let [type (get headers "type")
|
|
to (get headers "to")
|
|
priority (get headers "priority")
|
|
commit (get headers "commit")
|
|
task-name (get headers "task")
|
|
note-message (get headers "message")
|
|
[recipients recipient-errors] (validate-recipients to)
|
|
field-errors (for [field ordered
|
|
:let [valid? (case [type field]
|
|
["git_handoff" "type"] true
|
|
["git_handoff" "to"] true
|
|
["git_handoff" "priority"] true
|
|
["git_handoff" "task"] true
|
|
["git_handoff" "commit"] true
|
|
["note" "type"] true
|
|
["note" "to"] true
|
|
["note" "priority"] true
|
|
["note" "message"] true
|
|
false)]
|
|
:when (and type (not valid?))]
|
|
(format "Header '%s' is not allowed for type '%s'." field type))
|
|
base-errors (cond-> []
|
|
(str/blank? type) (conj "Missing required header 'type'.")
|
|
(str/blank? to) (conj "Missing required header 'to'.")
|
|
(str/blank? priority) (conj "Missing required header 'priority'.")
|
|
(and (not (str/blank? type)) (not (allowed-types type)))
|
|
(conj (format "Header 'type' must be one of git_handoff or note; got '%s'." type))
|
|
(and (not (str/blank? priority)) (not (valid-priority? priority)))
|
|
(conj (format "Header 'priority' must be two digits from 00 to 99; got '%s'." priority)))
|
|
[canonical commit-error]
|
|
(if (= "git_handoff" type)
|
|
(cond
|
|
(str/blank? commit) [nil "Missing required header 'commit' for git_handoff."]
|
|
(not (re-matches #"[0-9a-fA-F]{10}" commit))
|
|
[nil (format "Header 'commit' must be exactly 10 hexadecimal characters; got '%s'." commit)]
|
|
:else (canonical-commit commit))
|
|
[nil nil])
|
|
git-errors (cond-> []
|
|
(= "git_handoff" type)
|
|
(into (cond-> []
|
|
(str/blank? task-name)
|
|
(conj "Missing required header 'task' for git_handoff.")
|
|
(> (count (or task-name "")) 80)
|
|
(conj (format "Header 'task' must be no longer than 80 characters; got %d." (count task-name)))))
|
|
(and (not= "git_handoff" type) (not (str/blank? commit)))
|
|
(conj "Header 'commit' is only allowed for git_handoff.")
|
|
(and (not= "git_handoff" type) (not (str/blank? task-name)))
|
|
(conj "Header 'task' is only allowed for git_handoff.")
|
|
commit-error
|
|
(conj commit-error))
|
|
note-errors (cond-> []
|
|
(= "note" type)
|
|
(into (cond-> []
|
|
(str/blank? note-message)
|
|
(conj "Missing required header 'message' for note.")
|
|
(> (count (or note-message "")) 80)
|
|
(conj (format "Header 'message' must be no longer than 80 characters; got %d." (count note-message)))))
|
|
(and (not= "note" type) (not (str/blank? note-message)))
|
|
(conj "Header 'message' is only allowed for note."))]
|
|
{:recipients recipients
|
|
:canonical-commit canonical
|
|
:errors (vec (concat base-errors recipient-errors field-errors git-errors note-errors))}))
|
|
|
|
(defn next-sequence []
|
|
(let [dir (state-dir)
|
|
seq-file (fs/path dir "sequence")
|
|
lock-dir (fs/path dir "sequence.lock")]
|
|
(fs/create-dirs dir)
|
|
(loop []
|
|
(if (try
|
|
(fs/create-dir lock-dir)
|
|
true
|
|
(catch java.nio.file.FileAlreadyExistsException _
|
|
false))
|
|
nil
|
|
(do
|
|
(Thread/sleep 50)
|
|
(recur))))
|
|
(try
|
|
(let [last-value (if (fs/exists? seq-file)
|
|
(try
|
|
(Long/parseLong (str/trim (slurp (str seq-file))))
|
|
(catch Exception _ 0))
|
|
0)
|
|
next-value (inc last-value)
|
|
formatted (format "%06d" next-value)]
|
|
(spit (str seq-file) (str formatted "\n"))
|
|
formatted)
|
|
(finally
|
|
(fs/delete lock-dir)))))
|
|
|
|
(defn body [type sender canonical-commit note-message]
|
|
(case type
|
|
"git_handoff" (str "Re-read your role and constitution.\n\nmerge_and_process " sender " " canonical-commit)
|
|
"note" (str "Re-read your role and constitution.\n\n" note-message)))
|
|
|
|
(defn write-handoff! [{:keys [headers recipients canonical-commit sender]}]
|
|
(let [timestamp-id (id-timestamp)
|
|
created-at (timestamp)
|
|
sequence (next-sequence)
|
|
id (str timestamp-id "_" sequence "_from_" sender)
|
|
recipient-slug (str/join "_" recipients)
|
|
priority (get headers "priority")
|
|
type (get headers "type")
|
|
filename (str priority "_" timestamp-id "_" sequence "_from_" sender "_to_" recipient-slug ".handoff")
|
|
outbox-dir (fs/path (state-dir) "outbox")
|
|
tmp-dir (fs/path outbox-dir "tmp")
|
|
tmp-file (fs/path tmp-dir (str filename ".tmp"))
|
|
outbox-file (fs/path outbox-dir filename)
|
|
handoff-body (body type sender canonical-commit (get headers "message"))
|
|
lines (cond-> [(str "id: " id)
|
|
(str "from: " sender)
|
|
(str "to: " (str/join "," recipients))
|
|
(str "priority: " priority)
|
|
(str "type: " type)]
|
|
(= "git_handoff" type)
|
|
(conj (str "role: " sender)
|
|
(str "task: " (get headers "task"))
|
|
(str "commit: " canonical-commit))
|
|
(= "note" type)
|
|
(conj (str "message: " (get headers "message")))
|
|
true
|
|
(conj (str "created_at: " created-at)
|
|
""
|
|
handoff-body))]
|
|
(doseq [dir [tmp-dir outbox-dir (fs/path (state-dir) "sent") (fs/path (state-dir) "failed")]]
|
|
(fs/create-dirs dir))
|
|
(spit (str tmp-file) (str (str/join "\n" lines) "\n"))
|
|
(fs/move tmp-file outbox-file)
|
|
outbox-file))
|
|
|
|
(defn error-report [draft errors]
|
|
(binding [*out* *err*]
|
|
(println "HANDOFF INVALID:" (str draft))
|
|
(println)
|
|
(println "Errors:")
|
|
(doseq [error errors]
|
|
(println "-" error))
|
|
(println)
|
|
(println usage-text)))
|
|
|
|
(defn -main [& args]
|
|
(when (not= 1 (count args))
|
|
(usage)
|
|
(System/exit 1))
|
|
(let [draft (fs/path (first args))]
|
|
(when-not (fs/regular-file? draft)
|
|
(exit! 1 (str "Draft file not found: " draft)))
|
|
(let [sender (sender-role)]
|
|
(when-not (role-known? sender)
|
|
(exit! 1 (str "Unknown sender role: " sender)))
|
|
(let [{:keys [headers ordered errors]} (parse-draft draft)
|
|
validation (validate headers ordered)
|
|
all-errors (vec (concat errors (:errors validation)))]
|
|
(when (seq all-errors)
|
|
(error-report draft all-errors)
|
|
(System/exit 2))
|
|
(let [outbox-file (write-handoff! {:headers headers
|
|
:recipients (:recipients validation)
|
|
:canonical-commit (:canonical-commit validation)
|
|
:sender sender})]
|
|
(fs/delete draft)
|
|
(println "HANDOFF QUEUED:" (str outbox-file)))))))
|
|
|
|
(apply -main *command-line-args*)
|