test/test-send-dedup.sgl

1;; Unit tests for (courier dedup) -- the persistent send-idempotency

2;; backstop that stops the send-path duplication storm.

3;;

4;; The storm is: a send whose ack read is slow gets the leader's MCP

5;; client to SIGKILL courier and re-issue the same send; each attempt

6;; reaches Telegram, so one logical send is delivered N times. The old

7;; in-memory dedup could not stop it because a restarted process starts

8;; with an empty cache. These tests pin the behaviour that fixes it:

9;; the dedup is file-backed (survives "restart" = a second call reading

10;; the same file) and a key is recorded BEFORE delivery.

12(import (sigil test)

13 (sigil core)

14 (sigil string)

15 (sigil fs)

16 (sigil path)

17 (sigil process)

18 (courier dedup))

20(define (fresh-path)

21 (path-join (make-temp-directory) "send-dedup.log"))

23;; ============================================================

24;; Key hashing

25;; ============================================================

27(test-group "send-dedup-key"

28 (test "is deterministic for the same (chat-id, text)"

29 (assert-equal (send-dedup-key 331005009 "hello")

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

32 (test "differs for different text"

33 (assert-true (not (string=? (send-dedup-key 331005009 "hello")

34 (send-dedup-key 331005009 "hellO")))))

36 (test "differs for different chat-id"

37 (assert-true (not (string=? (send-dedup-key 1 "hi")

38 (send-dedup-key 2 "hi")))))

40 (test "accepts a string chat-id equivalently to a number"

41 (assert-equal (send-dedup-key 42 "x")

42 (send-dedup-key "42" "x")))

44 (test "is a single hex token safe for line-based storage"

45 ;; Text with spaces/newlines must not leak into the key (which is

46 ;; stored as `<epoch> <key>` on one line).

47 (let ((k (send-dedup-key 7 "multi\nline text with spaces")))

48 (assert-false (string-contains? k " "))

49 (assert-false (string-contains? k "\n")))))

51;; ============================================================

52;; check-and-record: the core suppress/proceed decision

53;; ============================================================

55(test-group "dedup-check-and-record!"

56 (test "a new key proceeds; an immediate repeat is suppressed"

57 (let ((path (fresh-path))

58 (k (send-dedup-key 1 "msg")))

59 (assert-equal 'proceed (dedup-check-and-record! path k 1000 60))

60 (assert-equal 'suppress (dedup-check-and-record! path k 1001 60))))

62 (test "distinct keys never suppress each other"

63 (let ((path (fresh-path))

64 (a (send-dedup-key 1 "aaa"))

65 (b (send-dedup-key 1 "bbb")))

66 (assert-equal 'proceed (dedup-check-and-record! path a 1000 60))

67 (assert-equal 'proceed (dedup-check-and-record! path b 1000 60))))

69 (test "a repeat AFTER the window proceeds again (entry expired)"

70 (let ((path (fresh-path))

71 (k (send-dedup-key 1 "msg")))

72 (assert-equal 'proceed (dedup-check-and-record! path k 1000 60))

73 ;; 61s later, outside the 60s window

74 (assert-equal 'proceed (dedup-check-and-record! path k 1061 60))))

76 (test "suppression refreshes the timestamp (sliding window)"

77 ;; Record at t=1000; hit at t=1050 (within 60) suppresses AND

78 ;; refreshes to 1050; a hit at t=1100 is 50s after the refresh, so

79 ;; still within the window -> a retry loop stays suppressed as long

80 ;; as it keeps firing.

81 (let ((path (fresh-path))

82 (k (send-dedup-key 1 "msg")))

83 (assert-equal 'proceed (dedup-check-and-record! path k 1000 60))

84 (assert-equal 'suppress (dedup-check-and-record! path k 1050 60))

85 (assert-equal 'suppress (dedup-check-and-record! path k 1100 60)))))

87;; ============================================================

88;; Persistence across "restart" (a second reader of the same file)

89;; ============================================================

91(test-group "persistence across restart"

92 (test "a key recorded by one call is seen by a later call on the same file"

93 ;; This is the whole fix: process A records the key (before it is

94 ;; SIGKILLed mid-send), process B re-issues the same send and reads

95 ;; the SAME file -> suppress. Modeled here as two calls sharing path.

96 (let ((path (fresh-path))

97 (k (send-dedup-key 331005009 "storm")))

98 (assert-equal 'proceed (dedup-check-and-record! path k 5000 60))

99 ;; "process B" -- brand new call, no in-memory state, same file

100 (assert-equal 'suppress (dedup-check-and-record! path k 5002 60))))

101

102 (test "recorded entries are loadable from disk"

103 (let ((path (fresh-path))

104 (k (send-dedup-key 1 "persisted")))

105 (dedup-check-and-record! path k 2000 60)

106 (let ((entries (dedup-load-entries path)))

107 (assert-equal 1 (length entries))

108 (assert-equal k (car (car entries)))

109 (assert-equal 2000 (cdr (car entries)))))))

110

111;; ============================================================

112;; unrecord: release a key when delivery definitely did not happen

113;; ============================================================

114

115(test-group "dedup-unrecord!"

116 (test "unrecording a key lets the next send proceed"

117 (let ((path (fresh-path))

118 (k (send-dedup-key 1 "msg")))

119 (assert-equal 'proceed (dedup-check-and-record! path k 1000 60))

120 (dedup-unrecord! path k)

121 (assert-equal 'proceed (dedup-check-and-record! path k 1001 60))))

122

123 (test "unrecording one key leaves others intact"

124 (let ((path (fresh-path))

125 (a (send-dedup-key 1 "a"))

126 (b (send-dedup-key 1 "b")))

127 (dedup-check-and-record! path a 1000 60)

128 (dedup-check-and-record! path b 1000 60)

129 (dedup-unrecord! path a)

130 (assert-equal 'proceed (dedup-check-and-record! path a 1001 60))

131 (assert-equal 'suppress (dedup-check-and-record! path b 1001 60))))

132

133 (test "unrecording on a missing file is a no-op (no crash)"

134 (let ((path (fresh-path))

135 (k (send-dedup-key 1 "x")))

136 (dedup-unrecord! path k) ;; file does not exist yet

137 (assert-equal 'proceed (dedup-check-and-record! path k 1000 60)))))

138

139;; ============================================================

140;; prune + robustness

141;; ============================================================

142

143(test-group "dedup-prune"

144 (test "drops entries older than the window, keeps fresh ones"

145 (let ((entries (list (cons "old" 1000) (cons "fresh" 1900))))

146 (let ((kept (dedup-prune entries 1950 60)))

147 (assert-equal 1 (length kept))

148 (assert-equal "fresh" (car (car kept)))))))

149

150(test-group "robustness"

151 (test "a malformed dedup file loads as empty (guarded), send proceeds"

152 (let ((path (fresh-path)))

153 (ensure-directory (path-dirname path))

154 (write-file-string path "garbage no epoch here\n\n \n")

155 (assert-equal '() (dedup-load-entries path))

156 (assert-equal 'proceed

157 (dedup-check-and-record! path (send-dedup-key 1 "x") 1000 60)))))

158

159;; ============================================================

160;; Config overrides

161;; ============================================================

162

163(test-group "config overrides"

164 (test "COURIER_SEND_DEDUP_WINDOW overrides the default window"

165 (setenv! "COURIER_SEND_DEDUP_WINDOW" "120")

166 (assert-equal 120 (send-dedup-window))

167 (setenv! "COURIER_SEND_DEDUP_WINDOW" "")

168 (assert-equal *send-dedup-window* (send-dedup-window)))

169

170 (test "a non-positive / non-numeric window falls back to the default"

171 (setenv! "COURIER_SEND_DEDUP_WINDOW" "0")

172 (assert-equal *send-dedup-window* (send-dedup-window))

173 (setenv! "COURIER_SEND_DEDUP_WINDOW" "nonsense")

174 (assert-equal *send-dedup-window* (send-dedup-window))

175 (setenv! "COURIER_SEND_DEDUP_WINDOW" ""))

176

177 (test "COURIER_SEND_DEDUP_FILE overrides the path"

178 (setenv! "COURIER_SEND_DEDUP_FILE" "/tmp/custom-dedup.log")

179 (assert-equal "/tmp/custom-dedup.log" (send-dedup-path))

180 (setenv! "COURIER_SEND_DEDUP_FILE" "")))