test/test-claim.sgl

1;; Unit tests for (courier claim) -- the single-poller claim.

2;;

3;; Telegram allows ONE getUpdates consumer per bot token. Every leader-mode

4;; courier used to start its own poller, so N concurrent sessions produced N

5;; pollers and a continuous 409 stream (measured 2026-08-04: three at once).

6;; These tests pin the claim's contract; the end-to-end behaviour -- two real

7;; couriers, one poller child, zero 409s at a mock that CAN produce them -- is

8;; proved by repro/repro-single-poller.sh.

9;;

10;; Note on liveness: under the test runner the "courier" process is the sigil

11;; runtime, so pid-liveness compares /proc/<pid>/comm against OUR OWN comm

12;; rather than a hardcoded name. That is deliberate in the implementation and

13;; is what makes these tests meaningful here at all.

15(import (sigil test)

16 (sigil core)

17 (sigil string)

18 (sigil fs)

19 (sigil path)

20 (sigil process)

21 (courier dedup)

22 (only (courier claim)

23 acquire-poller-claim! release-poller-claim! poller-claim-held?

24 abandon-poller-claim! poller-claim-path claim-token-hash

25 read-claim-owner pid-liveness claim-identity identity-pid

26 identity-start proc-start-time))

28;; Every existing test predates the force? argument and means "the normal,

29;; unforced path", so bind that spelling once rather than threading #f through

30;; twenty call sites.

31(define (acquire-poller-claim/1 token)

32 (acquire-poller-claim! token #f))

34(define (fresh-dir)

35 (let ((d (make-temp-directory)))

36 (setenv! "COURIER_RELAY_DIR" (path-join d "relays"))

37 d))

39;; ============================================================

40;; Token hashing

41;; ============================================================

43(test-group "claim-token-hash"

44 (test "is deterministic"

45 (assert-equal (claim-token-hash "123456:AAbbCC")

46 (claim-token-hash "123456:AAbbCC")))

48 (test "differs for different tokens"

49 (assert-true (not (string=? (claim-token-hash "123456:AAbbCC")

50 (claim-token-hash "123456:AAbbCD")))))

52 (test "is a fixed 12 hex characters regardless of the token"

53 (assert-equal 12 (string-length (claim-token-hash "a")))

54 (assert-equal 12 (string-length (claim-token-hash "")))

55 (assert-equal 12 (string-length

56 (claim-token-hash

57 "9999999999:AAEEFFbbccddeeff00112233445566778899"))))

59 ;; The zero-padding branch only runs for a hash with a leading zero nibble,

60 ;; which is 1 token in 16 -- so it would otherwise sit unexecuted until it

61 ;; failed in production. "tok-pad-2400" hashes to 0x6175bd22d28fede (15 hex

62 ;; digits), which forces it. The expected value is derived independently of

63 ;; this implementation: FNV-1a("tok-pad-2400") padded left to 16 hex digits,

64 ;; first 12 taken.

65 (test "zero-pads a short hash instead of truncating a different window"

66 (assert-equal 12 (string-length (claim-token-hash "tok-pad-2400")))

67 (assert-equal "06175bd22d28" (claim-token-hash "tok-pad-2400")))

69 ;; The token must never be recoverable from anything written to disk.

70 (test "never embeds the token itself"

71 (let ((token "123456:SECRETSECRETSECRET"))

72 (assert-true (not (string-contains? (claim-token-hash token)

73 "SECRET")))

74 (assert-true (not (string-contains? (poller-claim-path token)

75 "SECRET"))))))

77(test-group "poller-claim-path"

78 (test "is scoped to the token"

79 (let ((d (fresh-dir)))

80 (assert-true (not (string=? (poller-claim-path "bot-one")

81 (poller-claim-path "bot-two"))))))

83 (test "is scoped to the relay dir, so tests never contend with the live one"

84 (let ((a (begin (fresh-dir) (poller-claim-path "same-token")))

85 (b (begin (fresh-dir) (poller-claim-path "same-token"))))

86 (assert-true (not (string=? a b))))))

88;; ============================================================

89;; Liveness -- three states, not two

90;; ============================================================

92(test-group "pid-liveness"

93 ;; POSITIVE CONTROL. If this fails, every 'dead below is meaningless:

94 ;; an instrument that answers 'dead for everything would pass those tests

95 ;; and would silently break every claim it ever saw.

96 (test "reports our own pid alive"

97 (assert-equal 'alive (pid-liveness (number->string (process-id)))))

99 (test "reports an impossible pid dead"

100 (assert-equal 'dead (pid-liveness "999999")))

101

102 (test "reports garbage dead rather than raising"

103 (assert-equal 'dead (pid-liveness "not-a-pid")))

104

105 (test "can read our own start time (the recycled-pid discriminator works)"

106 (assert-true (string? (proc-start-time (number->string (process-id)))))

107 (assert-true (> (string-length

108 (proc-start-time (number->string (process-id)))) 0)))

109

110 (test "reads nothing for a pid that does not exist"

111 (assert-equal #f (proc-start-time "999999")))

112

113 ;; The recycled-pid discriminator, tested from BOTH sides against the SAME

114 ;; live pid. Only testing the 'dead side would be satisfied by an

115 ;; implementation that always answers 'dead -- which is what would break

116 ;; every claim it ever saw.

117 (test "a live pid with its REAL start time is alive"

118 (assert-equal 'alive

119 (pid-liveness (string-append "1:" (proc-start-time "1")))))

120

121 (test "a live pid with a DIFFERENT start time is dead (recycled pid)"

122 (assert-equal 'dead (pid-liveness "1:99999999")))

123

124 ;; This is the production case the comm-based version got wrong: two live

125 ;; couriers run from /tmp/mcp-bins/courier-<launcher-pid>, so their command

126 ;; NAMES differ. Identity must not care.

127 (test "liveness does not depend on the process name matching ours"

128 (assert-equal 'alive

129 (pid-liveness (string-append "1:" (proc-start-time "1"))))

130 (assert-true (not (string=? (proc-start-time "1")

131 (proc-start-time

132 (number->string (process-id)))))))

133

134 (test "a legacy pid-only claim reads alive, never dead, while the pid exists"

135 (assert-equal 'alive (pid-liveness "1"))

136 (assert-equal 'dead (pid-liveness "999999")))

137

138 (test "our own identity round-trips"

139 (assert-equal (number->string (process-id))

140 (identity-pid (claim-identity)))

141 (assert-equal 'alive (pid-liveness (claim-identity)))))

142

143;; ============================================================

144;; Acquire / release

145;; ============================================================

146

147(test-group "acquire-poller-claim!"

148 (test "a first caller acquires"

149 (fresh-dir)

150 (assert-equal 'acquired (acquire-poller-claim/1 "tok-a"))

151 (release-poller-claim!))

152

153 (test "records OUR pid in the claim"

154 (fresh-dir)

155 (acquire-poller-claim/1 "tok-b")

156 (assert-equal (claim-identity)

157 (read-claim-owner (poller-claim-path "tok-b")))

158 (release-poller-claim!))

159

160 (test "release removes the claim"

161 (fresh-dir)

162 (acquire-poller-claim/1 "tok-c")

163 (release-poller-claim!)

164 (assert-equal #f (read-claim-owner (poller-claim-path "tok-c"))))

165

166 (test "release is safe when nothing is held"

167 (fresh-dir)

168 (release-poller-claim!)

169 (release-poller-claim!)

170 (assert-true #t))

171

172 ;; A claim left by a process that is GONE must not block the estate: that

173 ;; is the SIGKILL case, and SIGKILL is routine (an /mcp reconnect is one).

174 (test "breaks a stale claim whose owner is gone"

175 (let ((d (fresh-dir)))

176 (let ((path (poller-claim-path "tok-stale")))

177 (ensure-directory (path-dirname path))

178 (make-symlink "999999" path)

179 (assert-equal "999999" (read-claim-owner path))

180 (assert-equal 'acquired (acquire-poller-claim/1 "tok-stale"))

181 (assert-equal (claim-identity) (read-claim-owner path))

182 (release-poller-claim!))))

183

184 ;; A recycled pid is now detected by START TIME, not by name, so a claim

185 ;; recording (pid, starttime) whose pid was reused reads dead and is broken.

186 (test "breaks a claim whose pid was recycled (start time differs)"

187 (let ((d (fresh-dir)))

188 (let ((path (poller-claim-path "tok-recycled")))

189 (ensure-directory (path-dirname path))

190 (make-symlink "1:99999999" path) ;; pid 1 is alive, but not THAT one

191 (assert-equal 'acquired (acquire-poller-claim/1 "tok-recycled"))

192 (assert-equal (claim-identity) (read-claim-owner path))

193 (release-poller-claim!))))

194

195 ;; DELIBERATE SEMANTIC CHOICE, and the direction matters. A claim written by

196 ;; an older build records only a pid, so it cannot be discriminated from a

197 ;; recycled one. We treat it as ALIVE and leave it alone. Treating it as

198 ;; dead would mean that the first instance running the new build breaks the

199 ;; live holder's claim and starts a second poller -- which is precisely the

200 ;; bug, triggered by the upgrade itself. The cost of this choice is that a

201 ;; legacy claim whose pid gets recycled is not breakable; it self-heals on

202 ;; the holder's next clean shutdown, which deletes the claim.

203 (test "leaves a legacy pid-only claim alone while that pid is alive"

204 (let ((d (fresh-dir)))

205 (let ((path (poller-claim-path "tok-legacy")))

206 (ensure-directory (path-dirname path))

207 (make-symlink "1" path)

208 (assert-equal 'held-by-other (acquire-poller-claim/1 "tok-legacy"))

209 (assert-equal "1" (read-claim-owner path)))))

210

211 (test "still breaks a legacy pid-only claim once that pid is gone"

212 (let ((d (fresh-dir)))

213 (let ((path (poller-claim-path "tok-legacy-dead")))

214 (ensure-directory (path-dirname path))

215 (make-symlink "999999" path)

216 (assert-equal 'acquired (acquire-poller-claim/1 "tok-legacy-dead"))

217 (assert-equal (claim-identity) (read-claim-owner path))

218 (release-poller-claim!))))

219

220 (test "does not release a claim that now belongs to someone else"

221 (let ((d (fresh-dir)))

222 (let ((path (poller-claim-path "tok-steal")))

223 (acquire-poller-claim/1 "tok-steal")

224 ;; Someone else takes over (as would happen if we were SIGKILLed and

225 ;; a later instance broke our stale claim).

226 (delete-file path)

227 (make-symlink "1" path)

228 (release-poller-claim!)

229 (assert-equal "1" (read-claim-owner path))))))

230

231;; ============================================================

232;; Shared hash core

233;; ============================================================

234

235(test-group "fnv1a-hex"

236 (test "send-dedup-key is unchanged by sharing the hash core"

237 (assert-equal (fnv1a-hex "331005009:hello")

238 (send-dedup-key 331005009 "hello")))

239

240 (test "is deterministic and differs per input"

241 (assert-equal (fnv1a-hex "abc") (fnv1a-hex "abc"))

242 (assert-true (not (string=? (fnv1a-hex "abc") (fnv1a-hex "abd"))))))

243

244;; ============================================================

245;; COURIER_TELEGRAM_POLL_FORCE -- the escape hatch

246;; ============================================================

247;;

248;; The claim decides which session receives inbound Telegram messages, not

249;; merely which one avoids 409s. The periodic re-acquire recovers from a DEAD

250;; holder; it can do nothing about a live-but-abandoned session whose claim is

251;; perfectly valid. Forcing is how a specific session says "me, now".

252

253(test-group "forced takeover"

254 ;; SCOPE, stated plainly because the obvious test here is vacuous: the

255 ;; force branch is only reached when the owner reads as 'alive, and 'alive

256 ;; requires a live pid whose comm matches OURS -- i.e. a second courier,

257 ;; which does not exist inside a unit test. A claim owned by pid 1 looks

258 ;; like a recycled pid and takes the ORDINARY stale path whether or not

259 ;; force? is set, so asserting "forcing works" against it would pass

260 ;; without ever executing the force branch. (It did, on the first draft.)

261 ;;

262 ;; The live-owner takeover is therefore proved end-to-end in

263 ;; repro/repro-single-poller.sh case 9, with two real couriers. What is

264 ;; worth pinning HERE is that force? does not change any other outcome.

265 (test "force? does not change the stale-claim path (still plain 'acquired)"

266 (let ((d (fresh-dir)))

267 (let ((path (poller-claim-path "tok-forced-stale")))

268 (ensure-directory (path-dirname path))

269 (make-symlink "999999" path)

270 (assert-equal 'acquired (acquire-poller-claim! "tok-forced-stale" #t))

271 (assert-equal (claim-identity) (read-claim-owner path))

272 (release-poller-claim!))))

273

274 (test "force? does not change an uncontended acquire"

275 (let ((d (fresh-dir)))

276 (assert-equal 'acquired (acquire-poller-claim! "tok-forced-free" #t))

277 (release-poller-claim!)))

278

279 ;; The displaced holder must be able to SEE that it lost the claim --

280 ;; without this it would keep polling and there would be two consumers on

281 ;; the token again, which is the original bug arriving through the hatch.

282 (test "poller-claim-held? reports true only while we own the claim"

283 (let ((d (fresh-dir)))

284 (assert-equal 'acquired (acquire-poller-claim/1 "tok-held"))

285 (assert-true (poller-claim-held? "tok-held"))

286 ;; Someone forces it away.

287 (let ((path (poller-claim-path "tok-held")))

288 (delete-file path)

289 (make-symlink "1" path))

290 (assert-true (not (poller-claim-held? "tok-held")))

291 (abandon-poller-claim!)))

292

293 ;; Abandoning must not delete the new owner's claim, or the forced takeover

294 ;; would leave NOBODY polling.

295 (test "abandoning leaves the new owner's claim intact"

296 (let ((d (fresh-dir)))

297 (acquire-poller-claim/1 "tok-abandon")

298 (let ((path (poller-claim-path "tok-abandon")))

299 (delete-file path)

300 (make-symlink "1" path)

301 (abandon-poller-claim!)

302 (release-poller-claim!) ;; must be a no-op now

303 (assert-equal "1" (read-claim-owner path)))))

304

305 (test "poller-claim-held? is false when there is no claim at all"

306 (let ((d (fresh-dir)))

307 (assert-true (not (poller-claim-held? "tok-absent"))))))