diff --git a/lib/host/blog.sx b/lib/host/blog.sx index 579a228a..3a4f4dc8 100644 --- a/lib/host/blog.sx +++ b/lib/host/blog.sx @@ -1281,6 +1281,48 @@ (concat host/blog-rel-kinds (list (get host/blog--rel-cache slug))))))) (dream-redirect "/meta")))) +;; ── typed Ghost import (the radar genesis-import seam) ────────────── +;; Import ONE Ghost post (a dict of its columns, string keys) as a TYPED host post: +;; the {slug,title,sx_content,status} record + is-a article + Ghost columns mapped onto +;; article :field-values (custom_excerpt->subtitle, feature_image->hero) + tags landed as +;; tag-posts with tagged edges. The Ghost body is ALREADY sx_content (the Python +;; lexical_to_sx migration produced (~kg_cards/kg-*) markup), so we just carry it. So an +;; old Ghost post lands not as bare markup but as a first-class typed Article — fields on +;; the edit form, subtitle as a rendered standfirst, tags in the graph. Idempotent +;; (put!/seed!/relate! are sets). Contract: plans/NOTE-blog-types-for-radar.md. +(define host/blog-import-post! + (fn (gp) + (let ((slug (get gp "slug")) (title (get gp "title"))) + (begin + (host/blog-put! slug title (or (get gp "sx_content") "") (or (get gp "status") "published")) + (host/blog-relate! slug "article" "is-a") + (host/blog--set-field-values! slug + {"subtitle" (or (get gp "custom_excerpt") (get gp "excerpt") "") + "hero" (or (get gp "feature_image") "")}) + (for-each + (fn (tag) + (let ((tslug (host/blog-slugify tag))) + (begin + (host/blog-seed! tslug tag (str "(article (h1 \"" tag "\"))") "published") + (host/blog-relate! tslug "tag" "is-a") + (host/blog-relate! slug tslug "tagged")))) + (or (get gp "tags") (list))) + slug)))) +;; Import a batch; returns the imported slugs. +(define host/blog-import-all! + (fn (posts) (map host/blog-import-post! posts))) +;; POST /import — the genesis-import endpoint. Body = a text/sx LIST of Ghost post dicts +;; (radar's Postgres reader serialises rows to this); imports each as a typed post. +;; -> {:ok true :data {:imported N :slugs (...)}}. Guarded (admin). Runs in the serving +;; handler (IO resolver installed) so the per-post / per-tag loops are JIT-safe. +(define host/blog-import-handler + (fn (req) + (let ((raw (dream-body req))) + (let ((posts (if (or (nil? raw) (= raw "")) (list) (sxtp/-normalize (parse-safe raw))))) + (if (= (type-of posts) "list") + (host/ok {:imported (len posts) :slugs (host/blog-import-all! posts)}) + (host/error 400 "expected a text/sx list of Ghost post dicts")))))) + ;; GET //source — the raw sx_content as text/plain. Posts ARE SX source, so ;; this just hands back the stored markup (public; a published post's source is ;; not secret). 404 if the post is absent. @@ -1541,7 +1583,8 @@ (dream-post "/:slug/relate" (host/blog--protect-html resolve host/blog-relate-submit)) (dream-post "/:slug/unrelate" (host/blog--protect-html resolve host/blog-unrelate-submit)) (dream-post "/meta/new-type" (host/blog--protect-html resolve host/blog-meta-new-type)) - (dream-post "/meta/new-relation" (host/blog--protect-html resolve host/blog-meta-new-relation))))) + (dream-post "/meta/new-relation" (host/blog--protect-html resolve host/blog-meta-new-relation)) + (dream-post "/import" (host/blog--protect-html resolve host/blog-import-handler))))) ;; EXPERIMENTAL: create-only, UNGUARDED — POST /new form ingest with error ;; trapping but NO auth, for validating the editor->host publish loop on the diff --git a/lib/host/tests/blog.sx b/lib/host/tests/blog.sx index dd5a6bfd..5197bb47 100644 --- a/lib/host/tests/blog.sx +++ b/lib/host/tests/blog.sx @@ -716,6 +716,27 @@ (let ((body (dream-resp-body (host-bl-app (host-bl-req "/meta"))))) (list (contains? body ">Image") (contains? body "src:URL, alt:String"))) (list true true)) + +;; -- typed Ghost import (the radar genesis-import seam) -- +(host-bl-test "import-post! lands a Ghost post as a typed Article + fields + tags" + (begin + (host/blog-import-post! {"slug" "g1" "title" "G1" "sx_content" "(article (h1 \"G1\"))" + "status" "published" "custom_excerpt" "A standfirst" + "feature_image" "http://i/h.jpg" "tags" (list "News")}) + (list (host/blog-is-a? "g1" "article") + (get (host/blog-field-values-of "g1") "subtitle") + (get (host/blog-field-values-of "g1") "hero") + (contains? (host/blog-out "g1" "tagged") "news"))) + (list true "A standfirst" "http://i/h.jpg" true)) +(host-bl-test "POST /import (text/sx list of Ghost dicts) lands typed posts" + (begin + (host-bl-wapp (host-bl-send "POST" "/import" "Bearer good" "text/sx" + "({:slug \"g2\" :title \"G2\" :sx_content \"(p \\\"b\\\")\" :status \"published\" :custom_excerpt \"S2\"})")) + (list (host/blog-is-a? "g2" "article") (get (host/blog-field-values-of "g2") "subtitle"))) + (list true "S2")) +(host-bl-test "POST /import rejects a non-list body -> 400" + (dream-status (host-bl-wapp (host-bl-send "POST" "/import" "Bearer good" "text/sx" "{:x 1}"))) + 400) (host-bl-test "a post with no schema'd type is vacuously valid" (host/blog-type-valid? "ppost" "(p \"anything\")") true) (host-bl-test "edit-submit rejects content violating the type schema (not saved)"