;;~ title    "Upload a draft listing"
;;~ author   "lacuna"
;;~ version  1
;;~ mode     automation
;;~ flavor   gray
;;~ id       btn-upload
;;~ touches  (etsy-listings etsy-images)
;;~ summary  "Generated when the operator presses the Upload button. Creates a draft from a payload, attaches photos, lands in Etsy. Architect-shape: every on-result is a NAMED state fn, no inline lambdas. OAuth liveness is a framework precondition; not a cart state. Escalate carries a closed KIND symbol only — surface decides recovery."

(cart 'btn-upload
  '((author    . "lacuna")
    (version   . 1)
    (touches   . (etsy-listings etsy-images))
    (read-only . #f)))

;; ── start ─────────────────────────────────────────────────────────
;; Guard the payload, jump into create-draft.
(define (start ctx)
  (let ((payload (ctx-get 'payload ctx)))
    (if (null? payload)
        (escalate 'missing-payload null)
        (act 'etsy/create-draft (list payload) 'check-draft-result))))

;; ── check-draft-result ───────────────────────────────────────────
;; Named result handler — branches on what came back from the draft
;; creation. No inline lambda; nothing in this branch decides the
;; on-result of any further act. Serialisable.
(define (check-draft-result ctx)
  (let ((r (ctx-result ctx)))
    (cond
      ((eq? r 'rate-limited)
       (after 30 'start ctx))
      ((eq? r 'auth-stale)
       (escalate 'assistant-oauth-relogin null))
      (else
       (next 'attach-images (ctx-set 'draft r ctx))))))

;; ── attach-images ───────────────────────────────────────────────
;; Pop the head image off the list, fire upload-image, branch on the
;; response in a named state fn. The cart recurses through itself by
;; jumping back here from check-image-result.
(define (attach-images ctx)
  (let ((images (ctx-get 'images ctx)))
    (if (or (null? images) (zero? (length images)))
        (next 'announce ctx)
        (let ((draft (ctx-get 'draft ctx)))
          (act 'etsy/upload-image
               (list (draft-id draft) (car images))
               'check-image-result)))))

;; ── check-image-result ──────────────────────────────────────────
;; Result handler for the image upload. Success → drop head + recurse;
;; failure → saga compensation (rollback-draft). The compensation is
;; its own state fn with its own retry/backoff (rollback-retry).
(define (check-image-result ctx)
  (let ((r (ctx-result ctx))
        (images (ctx-get 'images ctx)))
    (cond
      ((eq? r 'ok)
       (next 'attach-images (ctx-set 'images (cdr images) ctx)))
      ((eq? r 'rate-limited)
       (after 30 'attach-images ctx))
      (else
       (next 'rollback-draft (ctx-set 'failure r ctx))))))

;; ── rollback-draft (saga compensation) ──────────────────────────
;; Roll back the half-uploaded draft so the operator's shop isn't
;; left in a half-published state.
(define (rollback-draft ctx)
  (let ((draft (ctx-get 'draft ctx)))
    (act 'etsy/delete-listing (list (draft-id draft)) 'check-rollback)))

;; ── check-rollback ──────────────────────────────────────────────
;; The compensation can itself fail — that's a real path. Retry once
;; with backoff, then escalate with the orphan draft id so a human
;; can clean it up.
(define (check-rollback ctx)
  (let ((r (ctx-result ctx)))
    (cond
      ((eq? r 'ok)
       (escalate 'image-upload-failed (ctx-get 'failure ctx)))
      ((eq? r 'rate-limited)
       (after 30 'rollback-draft ctx))
      (else
       (escalate 'rollback-failed (ctx-get 'draft ctx))))))

;; ── announce ────────────────────────────────────────────────────
;; Clean exit. The driver emits cart-end {outcome: done}; the surface
;; reads that off the bus and pops a calm "uploaded" pill.
(define (announce ctx) (done))