; lib/gitea/tests/wire.sx — Phase 3: pkt-line framing, object closure,
; smart-HTTP endpoints (info/refs, upload-pack, receive-pack), and the
; client (ls-remote/clone!/fetch!/push!) syncing two in-memory forges.

(define gitea-wire-pass 0)
(define gitea-wire-fail 0)
(define gitea-wire-fails (list))

(define
  gitea-wire-test
  (fn
    (name actual expected)
    (if
      (= actual expected)
      (set! gitea-wire-pass (+ gitea-wire-pass 1))
      (begin
        (set! gitea-wire-fail (+ gitea-wire-fail 1))
        (set! gitea-wire-fails (append gitea-wire-fails (list {:name name :expected (inspect expected) :actual (inspect actual)})))))))

; ── pkt-line framing ─────────────────────────────────────────────────

(gitea-wire-test "hex4 small" (gitea/hex4 5) "0005")
(gitea-wire-test "hex4 max" (gitea/hex4 65535) "ffff")
(gitea-wire-test "hex4-parse" (gitea/hex4-parse "001a") 26)
(gitea-wire-test
  "hex4 round trip"
  (gitea/hex4-parse (gitea/hex4 4242))
  4242)
(gitea-wire-test "pkt frames with length" (gitea/pkt "hi") "0006hi")
(gitea-wire-test
  "pkt-sections round trip"
  (gitea/pkt-sections (gitea/pkt-render (list (list "a" "bc") (list "z"))))
  (list (list "a" "bc") (list "z")))
(gitea-wire-test "pkt-sections empty" (gitea/pkt-sections "") (list))
(gitea-wire-test
  "pkt-sections flush only"
  (gitea/pkt-sections "0000")
  (list (list)))
(gitea-wire-test "pkt-fits? small" (gitea/pkt-fits? "x") true)

(define
  gw-big
  (reduce
    (fn (acc i) (str acc acc))
    "xxxxxxxxxx"
    (list
      1
      2
      3
      4
      5
      6
      7
      8
      9
      10
      11
      12
      13)))
(gitea-wire-test "pkt-fits? huge payload" (gitea/pkt-fits? gw-big) false)

; ── forge A with history ─────────────────────────────────────────────

(define gw-db (persist/mem-backend))
(define gw-forge (gitea/forge gw-db))
(gitea/user-create! gw-forge "alice")
(gitea/user-create! gw-forge "bob")
(gitea/user-create! gw-forge "rope")
(gitea/token-create! gw-forge "alice" "tok-a")
(gitea/token-create! gw-forge "bob" "tok-b")
(gitea/token-create! gw-forge "rope" "tok-r")
(gitea/repo-create! gw-forge "alice" "lib" {})
(gitea/collab-add! gw-forge "alice" "lib" "rope" "read")

(define gw-ga (gitea/repo-git gw-forge "alice" "lib"))
(git/add! gw-ga "README.md" "hello\n")
(git/add! gw-ga "src/a.txt" "alpha\n")
(define gw-c1 (git/commit! gw-ga {:message "init" :time 1 :author "alice"}))
(git/add! gw-ga "src/a.txt" "alpha2\n")
(define gw-c2 (git/commit! gw-ga {:message "more" :time 2 :author "alice"}))
(git/tag! gw-ga "v1" {:message "rel" :time 3})
(define gw-tag-cid (git/tag-get gw-ga "v1"))
(git/branch-create! gw-ga "dev" gw-c1)

; ── closure ──────────────────────────────────────────────────────────

; c1 = commit + root tree + src tree + 2 blobs
(gitea-wire-test
  "closure of c1"
  (len (gitea/closure-list gw-ga (list gw-c1)))
  5)
; c2 adds commit + new root + new src + new blob
(gitea-wire-test
  "closure of c2"
  (len (gitea/closure-list gw-ga (list gw-c2)))
  9)
(gitea-wire-test
  "pack-cids c2 given c1"
  (len (gitea/pack-cids gw-ga (list gw-c2) (list gw-c1)))
  4)
(gitea-wire-test
  "pack includes tip commit"
  (contains? (gitea/pack-cids gw-ga (list gw-c2) (list gw-c1)) gw-c2)
  true)
(gitea-wire-test
  "pack excludes had commit"
  (contains? (gitea/pack-cids gw-ga (list gw-c2) (list gw-c1)) gw-c1)
  false)
(gitea-wire-test
  "closure through tag object"
  (len (gitea/closure-list gw-ga (list gw-tag-cid)))
  10)
(gitea-wire-test
  "closure-complete? tip"
  (gitea/closure-complete? gw-ga (list gw-c2))
  true)
(gitea-wire-test
  "closure-complete? missing cid"
  (gitea/closure-complete? gw-ga (list "sx1:doesnotexist"))
  false)
(gitea-wire-test
  "obj-refs of commit"
  (len (gitea/obj-refs (git/read gw-ga gw-c2)))
  2)

; ── pack line verification ───────────────────────────────────────────

(gitea-wire-test
  "pack-line parses and verifies"
  (get (gitea/pack-line-parse (gitea/pack-line gw-ga gw-c1)) :cid)
  gw-c1)
(gitea-wire-test
  "pack-line tamper detected"
  (get
    (gitea/pack-line-parse (str gw-c1 " " (serialize (git/blob "evil"))))
    :error)
  "cid-mismatch")
(gitea-wire-test
  "unpack! rejects tampered pack"
  (get
    (gitea/unpack!
      gw-ga
      (list (str gw-c1 " " (serialize (git/blob "evil")))))
    :error)
  "cid-mismatch")

; ── server endpoints ─────────────────────────────────────────────────

(define gw-app (gitea/forge-app gw-forge))
(define gw-hdr (fn (tok) (if (nil? tok) {} {:authorization (str "Bearer " tok)})))
(define
  gw-get
  (fn (target tok) (gw-app (dream-request "GET" target (gw-hdr tok) ""))))
(define
  gw-post
  (fn
    (target tok body)
    (gw-app (dream-request "POST" target (gw-hdr tok) body))))

(gitea-wire-test
  "info/refs 200"
  (dream-status (gw-get "/alice/lib/info/refs" nil))
  200)
(gitea-wire-test
  "info/refs advertises main"
  (contains?
    (dream-resp-body (gw-get "/alice/lib/info/refs" nil))
    (str gw-c2 " heads/main"))
  true)
(gitea-wire-test
  "info/refs advertises dev"
  (contains?
    (dream-resp-body (gw-get "/alice/lib/info/refs" nil))
    (str gw-c1 " heads/dev"))
  true)
(gitea-wire-test
  "info/refs advertises tag"
  (contains?
    (dream-resp-body (gw-get "/alice/lib/info/refs" nil))
    (str gw-tag-cid " tags/v1"))
  true)
(gitea-wire-test
  "info/refs advertises HEAD"
  (contains?
    (dream-resp-body (gw-get "/alice/lib/info/refs" nil))
    "@ heads/main")
  true)
(gitea-wire-test
  "info/refs unknown repo 404"
  (dream-status (gw-get "/alice/none/info/refs" nil))
  404)

(define
  gw-up-body
  (fn
    (wants haves)
    (gitea/pkt-render
      (list
        (concat
          (map (fn (c) (str "want " c)) wants)
          (map (fn (c) (str "have " c)) haves))))))

(define
  gw-up-lines
  (fn
    (resp)
    (let
      ((s (gitea/pkt-sections (dream-resp-body resp))))
      (if (empty? s) (list) (first s)))))

(gitea-wire-test
  "upload-pack full clone size"
  (len
    (gw-up-lines
      (gw-post
        "/alice/lib/git-upload-pack"
        nil
        (gw-up-body (list gw-c2) (list)))))
  9)
(gitea-wire-test
  "upload-pack incremental size"
  (len
    (gw-up-lines
      (gw-post
        "/alice/lib/git-upload-pack"
        nil
        (gw-up-body (list gw-c2) (list gw-c1)))))
  4)
(gitea-wire-test
  "upload-pack lines all verify"
  (len
    (filter
      (fn (l) (get (gitea/pack-line-parse l) :error))
      (gw-up-lines
        (gw-post
          "/alice/lib/git-upload-pack"
          nil
          (gw-up-body (list gw-c2) (list))))))
  0)

(gitea-wire-test
  "receive-pack anon 401"
  (dream-status
    (gw-post
      "/alice/lib/git-receive-pack"
      nil
      (gitea/pkt-render (list (list) (list)))))
  401)
(gitea-wire-test
  "receive-pack read-only 403"
  (dream-status
    (gw-post
      "/alice/lib/git-receive-pack"
      "tok-r"
      (gitea/pkt-render (list (list) (list)))))
  403)

; private repo wire gating
(gitea/repo-create! gw-forge "alice" "priv" {:visibility "private"})
(define gw-gp (gitea/repo-git gw-forge "alice" "priv"))
(git/add! gw-gp "p.txt" "private\n")
(git/commit! gw-gp {:message "p" :time 1 :author "alice"})

(gitea-wire-test
  "private info/refs anon 404"
  (dream-status (gw-get "/alice/priv/info/refs" nil))
  404)
(gitea-wire-test
  "private info/refs owner 200"
  (dream-status (gw-get "/alice/priv/info/refs" "tok-a"))
  200)
(gitea-wire-test
  "private upload-pack anon 404"
  (dream-status
    (gw-post "/alice/priv/git-upload-pack" nil (gw-up-body (list) (list))))
  404)

; ── client: ls-remote ────────────────────────────────────────────────

(define gw-remote-anon (gitea/remote gw-app "alice" "lib" nil))
(define gw-remote-bob (gitea/remote gw-app "alice" "lib" "tok-b"))
(define gw-remote-rope (gitea/remote gw-app "alice" "lib" "tok-r"))

(define gw-ls (gitea/ls-remote gw-remote-anon))
(gitea-wire-test "ls-remote head" (get gw-ls :head) "heads/main")
(gitea-wire-test "ls-remote main" (get (get gw-ls :refs) "heads/main") gw-c2)
(gitea-wire-test "ls-remote dev" (get (get gw-ls :refs) "heads/dev") gw-c1)
(gitea-wire-test
  "ls-remote tag"
  (get (get gw-ls :refs) "tags/v1")
  gw-tag-cid)
(gitea-wire-test
  "ls-remote unknown repo"
  (gitea/ls-remote (gitea/remote gw-app "alice" "none" nil))
  nil)

; ── client: clone into forge B ───────────────────────────────────────

(define gw-db2 (persist/mem-backend))
(define gw-forge2 (gitea/forge gw-db2))
(gitea/user-create! gw-forge2 "bob")

(define
  gw-clone
  (gitea/clone! gw-forge2 "bob" "lib" gw-remote-anon {}))
(gitea-wire-test "clone returns record" (get gw-clone :owner) "bob")

(define gw-gb (gitea/repo-git gw-forge2 "bob" "lib"))
(gitea-wire-test "clone main" (git/branch-get gw-gb "main") gw-c2)
(gitea-wire-test "clone dev" (git/branch-get gw-gb "dev") gw-c1)
(gitea-wire-test "clone tag" (git/tag-get gw-gb "v1") gw-tag-cid)
(gitea-wire-test "clone HEAD" (git/head-target gw-gb) "heads/main")
(gitea-wire-test
  "clone default branch recorded"
  (get (gitea/repo-get gw-forge2 "bob" "lib") :default-branch)
  "main")
(gitea-wire-test "clone log" (git/log gw-gb gw-c2) (list gw-c2 gw-c1))
(gitea-wire-test
  "clone blob content"
  (git/blob-data
    (git/read gw-gb (get (gitea/tree-at gw-gb gw-c2 "src/a.txt") :cid)))
  "alpha2\n")
(gitea-wire-test
  "clone closure complete"
  (gitea/closure-complete? gw-gb (list gw-c2))
  true)
(gitea-wire-test
  "clone again conflicts"
  (get
    (gitea/clone! gw-forge2 "bob" "lib" gw-remote-anon {})
    :conflict)
  true)
(gitea-wire-test
  "clone unreachable remote errors"
  (get
    (gitea/clone!
      gw-forge2
      "bob"
      "ghost"
      (gitea/remote gw-app "alice" "none" nil)
      {})
    :error)
  404)
(gitea-wire-test
  "failed clone leaves no repo"
  (gitea/repo-exists? gw-forge2 "bob" "ghost")
  false)

; ── client: fetch after upstream moves ───────────────────────────────

(git/add! gw-ga "src/c.txt" "gamma\n")
(define gw-c3 (git/commit! gw-ga {:message "third" :time 4 :author "alice"}))

(define gw-fetch1 (gitea/fetch! gw-remote-anon gw-gb))
(gitea-wire-test
  "fetch stores new objects"
  (> (get gw-fetch1 :stored) 0)
  true)
(gitea-wire-test "fetch moves main" (git/branch-get gw-gb "main") gw-c3)
(gitea-wire-test
  "fetch closure complete"
  (gitea/closure-complete? gw-gb (list gw-c3))
  true)
(gitea-wire-test
  "fetch up-to-date is no-op"
  (get (gitea/fetch! gw-remote-anon gw-gb) :stored)
  0)

; ── client: push ─────────────────────────────────────────────────────

; bob gets write on the upstream, commits locally, pushes
(gitea/collab-add! gw-forge "alice" "lib" "bob" "write")
(git/checkout! gw-gb "main")
(git/add! gw-gb "src/b.txt" "beta\n")
(define gw-c4 (git/commit! gw-gb {:message "from-bob" :time 5 :author "bob"}))

(gitea-wire-test
  "push ok"
  (get (gitea/push! gw-remote-bob gw-gb "heads/main") :ok)
  true)
(gitea-wire-test
  "push moved upstream main"
  (git/branch-get gw-ga "main")
  gw-c4)
(gitea-wire-test
  "upstream has pushed objects"
  (gitea/closure-complete? gw-ga (list gw-c4))
  true)

; push auth: anon 401, read-only 403
(gitea-wire-test
  "push anon rejected"
  (get (gitea/push! gw-remote-anon gw-gb "heads/main") :error)
  401)
(gitea-wire-test
  "push read-only rejected"
  (get (gitea/push! gw-remote-rope gw-gb "heads/main") :error)
  403)

; non-fast-forward: upstream moves on while bob commits on the old tip
(git/checkout! gw-ga "main")
(git/add! gw-ga "src/d.txt" "delta\n")
(define gw-c5 (git/commit! gw-ga {:message "upstream-moves" :time 6 :author "alice"}))

(git/add! gw-gb "src/e.txt" "eps\n")
(define gw-c4b (git/commit! gw-gb {:message "bob-diverges" :time 7 :author "bob"}))

(gitea-wire-test
  "push non-fast-forward rejected"
  (get (gitea/push! gw-remote-bob gw-gb "heads/main") :ng)
  "non-fast-forward")
(gitea-wire-test
  "upstream main unchanged after ng"
  (git/branch-get gw-ga "main")
  gw-c5)

; recover: fetch (mirror moves local main to upstream), rebuild, push
(gitea/fetch! gw-remote-bob gw-gb)
(gitea-wire-test
  "fetch after ng syncs main"
  (git/branch-get gw-gb "main")
  gw-c5)
(git/checkout! gw-gb "main")
(git/add! gw-gb "src/e.txt" "eps\n")
(define gw-c6 (git/commit! gw-gb {:message "bob-rebased" :time 8 :author "bob"}))
(gitea-wire-test
  "push after sync ok"
  (get (gitea/push! gw-remote-bob gw-gb "heads/main") :ok)
  true)
(gitea-wire-test
  "upstream at bob's rebased tip"
  (git/branch-get gw-ga "main")
  gw-c6)

; branch create / delete over the wire
(git/branch-create! gw-gb "feat" gw-c6)
(gitea-wire-test
  "push new branch"
  (get (gitea/push! gw-remote-bob gw-gb "heads/feat") :ok)
  true)
(gitea-wire-test
  "upstream sees new branch"
  (git/branch-get gw-ga "feat")
  gw-c6)
(gitea-wire-test
  "push delete branch"
  (get (gitea/push-delete! gw-remote-bob gw-gb "heads/feat") :ok)
  true)
(gitea-wire-test "upstream branch deleted" (git/branch-get gw-ga "feat") nil)

; tag push
(git/tag-lightweight! gw-gb "v2")
(gitea-wire-test
  "push tag"
  (get (gitea/push! gw-remote-bob gw-gb "tags/v2") :ok)
  true)
(gitea-wire-test "upstream sees tag" (git/tag-get gw-ga "v2") gw-c6)

; guard rails
(gitea-wire-test
  "push unknown local ref"
  (get (gitea/push! gw-remote-bob gw-gb "heads/nope") :error)
  "no-such-local-ref")
(gitea-wire-test
  "apply-cmd rejects non-shared ref"
  (gitea/apply-cmd! gw-ga {:name "bogus/x" :new gw-c1 :old "-"})
  "ng bogus/x invalid-ref")
(gitea-wire-test
  "apply-cmd rejects missing objects"
  (gitea/apply-cmd! gw-ga {:name "heads/zzz" :new "sx1:missing" :old "-"})
  "ng heads/zzz missing-objects")

; private repo full round trip with credentials
(define gw-remote-priv (gitea/remote gw-app "alice" "priv" "tok-a"))
(gitea/user-create! gw-forge2 "alice")
(define
  gw-pclone
  (gitea/clone! gw-forge2 "alice" "priv" gw-remote-priv {:visibility "private"}))
(gitea-wire-test "private clone with token" (get gw-pclone :owner) "alice")
(gitea-wire-test
  "private clone anon fails"
  (get
    (gitea/clone!
      gw-forge2
      "alice"
      "priv2"
      (gitea/remote gw-app "alice" "priv" nil)
      {})
    :error)
  404)