test/ses-test.sgl — sigil-ses

1;;; Tests for sigil-ses

3(import (sigil core)

4 (sigil dict)

5 (sigil string)

6 (sigil struct)

7 (sigil json)

8 (sigil test)

9 (sigil crypto)

10 (amazon ses)

11 (amazon ses auth)

12 (amazon ses notify))

14;; ---------------------------------------------------------------

15;; SigV4 signing tests

16;; ---------------------------------------------------------------

18;; AWS test vector values

19;; Reference: https://docs.aws.amazon.com/general/latest/gr/sigv4-calculate-signature.html

20(define test-access-key "AKIDEXAMPLE")

21(define test-secret-key "wJalrXUtnFEMI/K7MDENG+bPxRfiCYEXAMPLEKEY")

22(define test-region "us-east-1")

23(define test-service "iam")

24;; 2015-08-30T12:36:00Z as a time list: (sec min hour day month year weekday yearday dst)

25(define test-time-list '(0 36 12 30 8 2015 0 0 0))

27(test-group "date formatting"

29 (test "format-amz-date"

30 (assert-equal "20150830T123600Z"

31 (format-amz-date test-time-list)))

33 (test "format-date-stamp"

34 (assert-equal "20150830"

35 (format-date-stamp test-time-list))))

37(test-group "hex conversion"

39 (test "hex->bytevector basic"

40 (let ((bv (hex->bytevector "deadbeef")))

41 (assert-equal 4 (bytevector-length bv))

42 (assert-equal #xde (bytevector-u8-ref bv 0))

43 (assert-equal #xad (bytevector-u8-ref bv 1))

44 (assert-equal #xbe (bytevector-u8-ref bv 2))

45 (assert-equal #xef (bytevector-u8-ref bv 3))))

47 (test "hex->bytevector empty"

48 (let ((bv (hex->bytevector "")))

49 (assert-equal 0 (bytevector-length bv)))))

51(test-group "signing key derivation"

53 (test "derive-signing-key matches AWS test vector"

54 ;; Expected signing key for the AWS test vector:

55 ;; Secret: wJalrXUtnFEMI/K7MDENG+bPxRfiCYEXAMPLEKEY

56 ;; Date: 20150830, Region: us-east-1, Service: iam

57 (let* ((key (derive-signing-key test-secret-key "20150830"

58 test-region test-service))

59 ;; Convert to hex for comparison

60 (key-hex (apply string-append

61 (map (lambda (i)

62 (let ((b (bytevector-u8-ref key i)))

63 (string-append

64 (if (< b 16) "0" "")

65 (number->string b 16))))

66 (iota (bytevector-length key))))))

67 (assert-equal "c4afb1cc5771d871763a393e44b703571b55cc28424d1a5e86da6ed3c154a4b9"

68 key-hex))))

70(test-group "canonical request"

72 (test "canonical request with headers"

73 (let* ((headers #{ host: "iam.amazonaws.com"

74 content-type: "application/x-www-form-urlencoded; charset=utf-8"

75 x-amz-date: "20150830T123600Z" })

76 (hp (canonical-headers-pair headers))

77 (creq (canonical-request "GET" "/" "" hp (sha256 ""))))

78 ;; Verify it starts with GET and contains sorted headers

79 (assert-true (string-contains? creq "GET"))

80 (assert-true (string-contains? creq "content-type:application/x-www-form-urlencoded; charset=utf-8"))

81 (assert-true (string-contains? creq "host:iam.amazonaws.com"))

82 (assert-true (string-contains? creq "x-amz-date:20150830T123600Z")))))

84(test-group "full sigv4 signing"

86 (test "sigv4-sign-request produces authorization header"

87 (let ((headers (sigv4-sign-request

88 test-access-key test-secret-key

89 test-region test-service

90 "GET" "iam.amazonaws.com" "/" ""

91 #{ content-type: "application/x-www-form-urlencoded; charset=utf-8" }

92 ""

93 test-time-list)))

94 ;; Check authorization header exists and has correct format

95 (let ((auth (dict-ref headers authorization:)))

96 (assert-true (string-starts-with? auth "AWS4-HMAC-SHA256 "))

97 (assert-true (string-contains? auth "Credential=AKIDEXAMPLE/20150830/us-east-1/iam/aws4_request"))

98 (assert-true (string-contains? auth "SignedHeaders="))

99 (assert-true (string-contains? auth "Signature=")))))

100

101 (test "sigv4-sign-request includes x-amz-date"

102 (let ((headers (sigv4-sign-request

103 test-access-key test-secret-key

104 test-region "ses"

105 "POST" "email.us-east-2.amazonaws.com"

106 "/v2/email/outbound-emails" ""

107 #{ content-type: "application/json" }

108 "{\"test\": true}"

109 test-time-list)))

110 (assert-equal "20150830T123600Z"

111 (dict-ref headers x-amz-date:)))))

112

113;; ---------------------------------------------------------------

114;; Client construction tests

115;; ---------------------------------------------------------------

116

117(test-group "client construction"

118

119 (test "default region"

120 (let ((c (ses-client access-key-id: "AK"

121 secret-access-key: "SK")))

122 (assert-true (ses-client? c))

123 (assert-equal "AK" (ses-client-access-key-id c))

124 (assert-equal "SK" (ses-client-secret-access-key c))

125 (assert-equal "us-east-2" (ses-client-region c))))

126

127 (test "custom region"

128 (let ((c (ses-client access-key-id: "AK"

129 secret-access-key: "SK"

130 region: "eu-west-1")))

131 (assert-equal "eu-west-1" (ses-client-region c)))))

132

133;; ---------------------------------------------------------------

134;; Response parsing tests

135;; ---------------------------------------------------------------

136

137(test-group "account parsing"

138

139 (test "parse account info"

140 (let ((data #{ SendQuota: #{ Max24HourSend: 50000

141 MaxSendRate: 14

142 SentLast24Hours: 127 }

143 EnforcementStatus: "HEALTHY" }))

144 (let ((acct (parse-account data)))

145 (assert-true (ses-account? acct))

146 (assert-equal 50000 (ses-account-send-quota acct))

147 (assert-equal 14 (ses-account-send-rate acct))

148 (assert-equal 127 (ses-account-sent-last-24h acct))

149 (assert-equal "HEALTHY" (ses-account-enforcement-status acct))))))

150

151(test-group "suppressed address parsing"

152

153 (test "parse suppressed address"

154 (let ((data #{ EmailAddress: "[email protected]"

155 Reason: "BOUNCE"

156 LastUpdateTime: "2026-03-15T10:00:00Z" }))

157 (let ((addr (parse-suppressed-address data)))

158 (assert-true (ses-suppressed-address? addr))

159 (assert-equal "[email protected]" (ses-suppressed-address-email addr))

160 (assert-equal "BOUNCE" (ses-suppressed-address-reason addr))

161 (assert-equal "2026-03-15T10:00:00Z"

162 (ses-suppressed-address-last-update addr))))))

163

164(test-group "identity parsing"

165

166 (test "parse verified identity"

167 (let ((data #{ VerifiedForSendingStatus: #t

168 DkimAttributes: #{ Status: "SUCCESS" }

169 MailFromAttributes: #{ MailFromDomainStatus: "SUCCESS" } }))

170 (let ((id (parse-identity "systemcrafters.net" data)))

171 (assert-true (ses-identity? id))

172 (assert-equal "systemcrafters.net" (ses-identity-name id))

173 (assert-true (ses-identity-verified? id))

174 (assert-equal "SUCCESS" (ses-identity-dkim-status id))

175 (assert-equal "SUCCESS" (ses-identity-mail-from-status id))))))

176

177;; ---------------------------------------------------------------

178;; SNS notification parsing tests

179;; ---------------------------------------------------------------

180

181(define bounce-json

182 (json-decode

183 (string-append

184 "{\"notificationType\": \"Bounce\","

185 " \"bounce\": {"

186 " \"bounceType\": \"Permanent\","

187 " \"bounceSubType\": \"General\","

188 " \"bouncedRecipients\": ["

189 " {\"emailAddress\": \"[email protected]\"},"

190 " {\"emailAddress\": \"[email protected]\"}"

191 " ],"

192 " \"timestamp\": \"2026-03-15T10:30:00Z\","

193 " \"feedbackId\": \"feedback-123\""

194 " }}")))

195

196(define complaint-json

197 (json-decode

198 (string-append

199 "{\"notificationType\": \"Complaint\","

200 " \"complaint\": {"

201 " \"complainedRecipients\": ["

202 " {\"emailAddress\": \"[email protected]\"}"

203 " ],"

204 " \"complaintFeedbackType\": \"abuse\","

205 " \"timestamp\": \"2026-03-16T14:00:00Z\","

206 " \"feedbackId\": \"feedback-456\""

207 " }}")))

208

209(define delivery-json

210 (json-decode "{\"notificationType\": \"Delivery\"}"))

211

212(test-group "bounce notification parsing"

213

214 (test "parse bounce notification"

215 (let ((n (parse-ses-notification bounce-json)))

216 (assert-true (ses-notification? n))

217 (assert-equal "Bounce" (ses-notification-type n))

218 (assert-equal "Permanent" (ses-notification-bounce-type n))

219 (assert-equal "General" (ses-notification-bounce-sub-type n))

220 (assert-equal #f (ses-notification-complaint-type n))

221 (assert-equal "2026-03-15T10:30:00Z" (ses-notification-timestamp n))

222 (assert-equal "feedback-123" (ses-notification-feedback-id n))))

223

224 (test "bounce addresses extracted"

225 (let ((n (parse-ses-notification bounce-json)))

226 (let ((addrs (ses-notification-addresses n)))

227 (assert-equal 2 (length addrs))

228 (assert-equal "[email protected]" (car addrs))

229 (assert-equal "[email protected]" (cadr addrs)))))

230

231 (test "ses-bounce? predicate"

232 (let ((n (parse-ses-notification bounce-json)))

233 (assert-true (ses-bounce? n))

234 (assert-false (ses-complaint? n))))

235

236 (test "ses-hard-bounce? predicate"

237 (let ((n (parse-ses-notification bounce-json)))

238 (assert-true (ses-hard-bounce? n)))))

239

240(test-group "complaint notification parsing"

241

242 (test "parse complaint notification"

243 (let ((n (parse-ses-notification complaint-json)))

244 (assert-true (ses-notification? n))

245 (assert-equal "Complaint" (ses-notification-type n))

246 (assert-equal "abuse" (ses-notification-complaint-type n))

247 (assert-equal #f (ses-notification-bounce-type n))

248 (assert-equal "2026-03-16T14:00:00Z" (ses-notification-timestamp n))

249 (assert-equal "feedback-456" (ses-notification-feedback-id n))))

250

251 (test "complaint addresses extracted"

252 (let ((n (parse-ses-notification complaint-json)))

253 (let ((addrs (ses-notification-addresses n)))

254 (assert-equal 1 (length addrs))

255 (assert-equal "[email protected]" (car addrs)))))

256

257 (test "ses-complaint? predicate"

258 (let ((n (parse-ses-notification complaint-json)))

259 (assert-true (ses-complaint? n))

260 (assert-false (ses-bounce? n)))))

261

262(test-group "other notification types"

263

264 (test "delivery notification returns #f"

265 (let ((n (parse-ses-notification delivery-json)))

266 (assert-false n))))

267

268;; ---------------------------------------------------------------

269;; Record construction tests

270;; ---------------------------------------------------------------

271

272(test-group "record construction"

273

274 (test "ses-email-result fields"

275 (let ((r (ses-email-result message-id: "msg-123")))

276 (assert-true (ses-email-result? r))

277 (assert-equal "msg-123" (ses-email-result-message-id r))))

278

279 (test "ses-account fields"

280 (let ((a (ses-account send-quota: 50000 send-rate: 14

281 sent-last-24h: 0 enforcement-status: "HEALTHY")))

282 (assert-equal 50000 (ses-account-send-quota a))

283 (assert-equal "HEALTHY" (ses-account-enforcement-status a))))

284

285 (test "ses-notification fields"

286 (let ((n (ses-notification type: "Bounce"

287 addresses: '("[email protected]")

288 bounce-type: "Permanent"

289 bounce-sub-type: "General"

290 complaint-type: #f

291 timestamp: "2026-01-01T00:00:00Z"

292 feedback-id: "fb-1"

293 raw: #{})))

294 (assert-true (ses-notification? n))

295 (assert-equal "Bounce" (ses-notification-type n))

296 (assert-equal '("[email protected]") (ses-notification-addresses n)))))

297

298(run-tests)