giles
e228d462eb
lib/git/sha1.sx: SHA-1 in pure SX over host bitwise prims (FIPS vectors + multi-block verified). lib/git/export.sx: native objects -> git payloads "<type> <len>\0<body>" with real git identity, golden-verified against git CLI (hash-object/mktree/commit-tree/mktag with pinned idents): tree entry sorting with dirs keyed "name/", raw 20-byte child shas, "40000" subtree mode, :mode overrides, deterministic ident defaults, trailing-newline message rule. export-closure/export-set emit a host-writable object table. Adapter-at-the-edge: native model untouched; zlib/packfiles remain host-side concerns. 25/25, total 252/252. Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
226 lines
6.4 KiB
Plaintext
226 lines
6.4 KiB
Plaintext
; lib/git/export.sx — git-wire EXPORT ADAPTER (flagged extension).
|
|
; Converts native sx-git objects into byte-exact git loose-object payloads:
|
|
; "<type> <len>\0<body>" with real git SHA-1 identity, golden-verified
|
|
; against git CLI output. This is an adapter at the edge — the base model
|
|
; stays native-CID (sx1:/sha256, typed extensible dicts). zlib/packfiles are
|
|
; host-side concerns and stay out of scope: the adapter emits type+bytes+sha1.
|
|
; Field mapping (commit/tag idents): :author/:email/:time/:tz with committer
|
|
; overrides :committer/:committer-email/:committer-time/:committer-tz;
|
|
; defaults email="<author>@sx", time=0, tz="+0000". Messages get a trailing
|
|
; newline if missing. Extra native fields do NOT survive export (git wire
|
|
; has nowhere to put them) — that loss is the point of native-first.
|
|
; Requires: lib/git/object.sx, lib/git/sha1.sx, lib/artdag/dag.sx.
|
|
|
|
(define git/export-nul (list->string (list (integer->char 0))))
|
|
|
|
; ---- tree entry details ----
|
|
; raw tree bytes use "40000" for subtrees (no leading zero); files default
|
|
; to 100644 unless the entry carries an explicit :mode (e.g. "100755")
|
|
(define
|
|
git/export-mode
|
|
(fn
|
|
(e)
|
|
(if
|
|
(has-key? e :mode)
|
|
(get e :mode)
|
|
(if (equal? (get e :kind) "tree") "40000" "100644"))))
|
|
|
|
; git sorts tree entries by name bytes with directories keyed as "name/"
|
|
(define
|
|
git/export-sortkey
|
|
(fn
|
|
(tree name)
|
|
(if
|
|
(equal? (git/entry-kind (git/tree-entry-for tree name)) "tree")
|
|
(str name "/")
|
|
name)))
|
|
|
|
(define
|
|
git/export-ins
|
|
(fn
|
|
(tree sorted n)
|
|
(cond
|
|
((empty? sorted) (list n))
|
|
((artdag/str<? (git/export-sortkey tree n) (git/export-sortkey tree (first sorted)))
|
|
(cons n sorted))
|
|
(else (cons (first sorted) (git/export-ins tree (rest sorted) n))))))
|
|
|
|
(define
|
|
git/export-sort-names
|
|
(fn
|
|
(tree names)
|
|
(reduce (fn (acc n) (git/export-ins tree acc n)) (list) names)))
|
|
|
|
; ---- ident + message formatting ----
|
|
(define git/export-or (fn (v dflt) (if (equal? v nil) dflt v)))
|
|
|
|
(define
|
|
git/export-author-ident
|
|
(fn
|
|
(obj)
|
|
(let
|
|
((name (git/export-or (get obj :author) "sx")))
|
|
(str
|
|
name
|
|
" <"
|
|
(git/export-or (get obj :email) (str name "@sx"))
|
|
"> "
|
|
(git/export-or (get obj :time) 0)
|
|
" "
|
|
(git/export-or (get obj :tz) "+0000")))))
|
|
|
|
(define
|
|
git/export-committer-ident
|
|
(fn
|
|
(obj)
|
|
(let
|
|
((name (git/export-or (get obj :committer) (git/export-or (get obj :author) "sx"))))
|
|
(str
|
|
name
|
|
" <"
|
|
(git/export-or
|
|
(get obj :committer-email)
|
|
(git/export-or (get obj :email) (str name "@sx")))
|
|
"> "
|
|
(git/export-or
|
|
(get obj :committer-time)
|
|
(git/export-or (get obj :time) 0))
|
|
" "
|
|
(git/export-or
|
|
(get obj :committer-tz)
|
|
(git/export-or (get obj :tz) "+0000"))))))
|
|
|
|
(define
|
|
git/export-message
|
|
(fn
|
|
(obj)
|
|
(let
|
|
((m (git/export-or (get obj :message) "")))
|
|
(let
|
|
((n (string-length m)))
|
|
(if
|
|
(and
|
|
(> n 0)
|
|
(equal? (substring m (- n 1) n) "\n"))
|
|
m
|
|
(str m "\n"))))))
|
|
|
|
; ---- object payloads ----
|
|
(define
|
|
git/export-entry
|
|
(fn
|
|
(type body)
|
|
(let
|
|
((full (str type " " (string-length body) git/export-nul body)))
|
|
{:type type :sha1 (git/sha1-hex full) :bytes full})))
|
|
|
|
(define
|
|
git/export-tree-body
|
|
(fn
|
|
(tree table)
|
|
(reduce
|
|
(fn
|
|
(acc name)
|
|
(let
|
|
((e (git/tree-entry-for tree name)))
|
|
(str
|
|
acc
|
|
(git/export-mode e)
|
|
" "
|
|
name
|
|
git/export-nul
|
|
(git/hex->raw (get (get table (git/entry-cid e)) :sha1)))))
|
|
""
|
|
(git/export-sort-names tree (git/tree-names tree)))))
|
|
|
|
(define
|
|
git/export-commit-body
|
|
(fn
|
|
(obj table)
|
|
(str
|
|
"tree "
|
|
(get (get table (git/commit-tree obj)) :sha1)
|
|
"\n"
|
|
(reduce
|
|
(fn (acc p) (str acc "parent " (get (get table p) :sha1) "\n"))
|
|
""
|
|
(git/commit-parents obj))
|
|
"author "
|
|
(git/export-author-ident obj)
|
|
"\n"
|
|
"committer "
|
|
(git/export-committer-ident obj)
|
|
"\n"
|
|
"\n"
|
|
(git/export-message obj))))
|
|
|
|
(define
|
|
git/export-tag-body
|
|
(fn
|
|
(obj table)
|
|
(str
|
|
"object "
|
|
(get (get table (git/tag-target obj)) :sha1)
|
|
"\n"
|
|
"type "
|
|
(get (get table (git/tag-target obj)) :type)
|
|
"\n"
|
|
"tag "
|
|
(git/tag-name obj)
|
|
"\n"
|
|
"tagger "
|
|
(git/export-author-ident obj)
|
|
"\n"
|
|
"\n"
|
|
(git/export-message obj))))
|
|
|
|
; ---- recursive closure export: table cid -> {:type :bytes :sha1} ----
|
|
(define
|
|
git/export-into
|
|
(fn
|
|
(repo cid table)
|
|
(if
|
|
(has-key? table cid)
|
|
table
|
|
(let
|
|
((obj (git/read repo cid)))
|
|
(cond
|
|
((git/blob? obj)
|
|
(assoc table cid (git/export-entry "blob" (git/blob-data obj))))
|
|
((git/tree? obj)
|
|
(let
|
|
((t2 (reduce (fn (tb name) (git/export-into repo (git/entry-cid (git/tree-entry-for obj name)) tb)) table (git/tree-names obj))))
|
|
(assoc
|
|
t2
|
|
cid
|
|
(git/export-entry "tree" (git/export-tree-body obj t2)))))
|
|
((git/commit? obj)
|
|
(let
|
|
((t2 (git/export-into repo (git/commit-tree obj) (reduce (fn (tb p) (git/export-into repo p tb)) table (git/commit-parents obj)))))
|
|
(assoc
|
|
t2
|
|
cid
|
|
(git/export-entry "commit" (git/export-commit-body obj t2)))))
|
|
((git/tag? obj)
|
|
(let
|
|
((t2 (git/export-into repo (git/tag-target obj) table)))
|
|
(assoc
|
|
t2
|
|
cid
|
|
(git/export-entry "tag" (git/export-tag-body obj t2)))))
|
|
(else table))))))
|
|
|
|
(define
|
|
git/export-closure
|
|
(fn (repo cid) (git/export-into repo cid {})))
|
|
|
|
; export one object (with its dependencies): {:type :bytes :sha1}
|
|
(define git/export (fn (repo cid) (get (git/export-closure repo cid) cid)))
|
|
|
|
(define git/export-sha (fn (repo cid) (get (git/export repo cid) :sha1)))
|
|
|
|
; host-writable set: {:head <sha1> :objects {sha1 -> {:type :bytes}}}
|
|
(define
|
|
git/export-set
|
|
(fn (repo cid) (let ((table (git/export-closure repo cid))) {:head (get (get table cid) :sha1) :objects (reduce (fn (acc c) (let ((e (get table c))) (assoc acc (get e :sha1) {:type (get e :type) :bytes (get e :bytes)}))) {} (keys table))})))
|