webhooks.bend

bend-kit-webhooks@0.11.0.1 · 508 lines · 71 definitions

1# Webhook signatures: Standard Webhooks sign and verify, Stripe and GitHub verify, over the raw body. Source: https://github.com/paymog/bend-kit/tree/main/webhooks
2import Base
3import bend-kit-crypto@0.2.2.2/crypto.bend as Crypto
4import bend-kit-time@0.3.0.0/time.bend as Time
5import bend-kit-int@0.2.0.0/int.bend as Int
6import bend-kit-encoding@0.5.0.0/encoding.bend as Enc
7import bend-kit-bytes@0.3.3.0/bytes.bend as Bytes
8import bend-kit-hairpin@0.13.0.1/hairpin.bend as Hairpin
9import bend-kit-retry@0.2.0.0/retry.bend as Retry
10import bend-kit-http@0.38.1.1/http.bend as Http
11
12# Every MAC is HMAC-SHA256 over the body exactly as received, never a re-encoding of parsed JSON.
13# Headers are Http.Req headers: lowercase names, octet-string values. Each verify hands the body back.
14# secrets: candidates, tried in turn, for key rotation. Every MAC comparison is Crypto.eq.ct.words.
15# now is explicit, so a check is deterministic; a handler passes Time.now().
16
17type Err is Data:
18  Missing{name: String}
19  BadSecret{}
20  BadId{}
21  BadTimestamp{}
22  TooOld{}
23  TooNew{}
24  NoMatch{}
25  CryptoErr{code: U32, msg: String}
26
27# ---- headers and text
28
29def field.head(xs: List<&2, String>) -> Maybe<&2, String>:
30  match xs:
31    case Nil{}:
32      None{}
33    case Con{v, t}:
34      Some{v}
35
36def field.of(r: Map<&2, List<&2, String>> & List<&2, String>) -> Maybe<&2, String>:
37  (h, xs) = r
38  field.head(xs)
39
40def field(+h: Map<&2, List<&2, String>>, k: String) -> Maybe<&2, String>:
41  field.of(Map.get(List<&2, String>, Nil{}, h, k))
42
43def need(+name: String, m: Maybe<&2, String>) -> Result<&1, &1, Err, String>:
44  match m:
45    case None{}:
46      Fail{Missing{name}}
47    case Some{v}:
48      Done{v}
49
50# s after the prefix p, or None.
51def strip(+p: String, +s: String) -> Maybe<&2, String>:
52  Bool.pick(Maybe<&2, String>, String.starts_with(s, p), Some{String.drop(s, String.length(p))}, None{})
53
54def push(m: Maybe<&2, String>, rest: List<&2, String>) -> List<&2, String>:
55  match m:
56    case None{}:
57      rest
58    case Some{s}:
59      Con{s, rest}
60
61def put(m: Map<&2, List<&2, String>>, k: String, v: String) -> Map<&2, List<&2, String>>:
62  Map.set(&2, List<&2, String>, m, k, Con{v, Nil{}})
63
64def digits(s: String) -> Bool:
65  match s:
66    case SNil{}:
67      True{}
68    case SCon{Chr{+c}, t}:
69      Bool.and(Bool.and(U32.is_le(48, c), U32.is_le(c, 57)), digits(t))
70
71def ts.some(ok: Bool, m: Maybe<&2, Int.I64>) -> Result<&1, &1, Err, Int.I64>:
72  match ok:
73    case False{}:
74      Fail{BadTimestamp{}}
75    case True{}:
76      match m:
77        case None{}:
78          Fail{BadTimestamp{}}
79        case Some{t}:
80          Done{t}
81
82# Unix seconds: 1 to 18 ASCII digits, no sign, so the parse never overflows.
83def ts.read(+s: String) -> Result<&1, &1, Err, Int.I64>:
84  +n = String.length(s)
85  ts.some(Bool.and(Bool.and(Nat.is_lt(0n, n), Nat.is_le(n, 18n)), digits(s)), Int.I64.read(s))
86
87def window.pick(old: Bool, ahead: Bool) -> Result<&1, &1, Err, Unit>:
88  match old:
89    case True{}:
90      Fail{TooOld{}}
91    case False{}:
92      Bool.pick(Result<&1, &1, Err, Unit>, ahead, Fail{TooNew{}}, Done{Unit{}})
93
94# t within tol seconds of now, either way.
95def window(+tol: U32, now: Time.Instant, t: Int.I64) -> Result<&1, &1, Err, Unit>:
96  match now:
97    case Time.Instant{n, ns}:
98      +d = Int.I64.sub(n, t)
99      +w = Int.I64.from_u32(tol)
100      window.pick(Int.I64.is_gt(d, w), Int.I64.is_lt(d, Int.I64.neg(w)))
101
102# A webhook id is not empty and has no '.', so id.timestamp.body reads one way.
103def id.check(+id: String) -> Result<&1, &1, Err, Unit>:
104  Bool.pick(Result<&1, &1, Err, Unit>, Bool.or(String.is_empty(id), String.contains(id, ".")), Fail{BadId{}}, Done{Unit{}})
105
106# ---- keys and signatures
107
108def b64.same(+s: String, r: Bytes.Bytes & Bytes.Bytes) -> Maybe<&1, Bytes.Bytes>:
109  (b, c) = r
110  Bool.pick(Maybe<&1, Bytes.Bytes>, String.eq(Bytes.to_base64(c), s), Some{b}, None{})
111
112def b64.canon(+s: String, m: Maybe<&1, Bytes.Bytes>) -> Maybe<&1, Bytes.Bytes>:
113  match m:
114    case None{}:
115      None{}
116    case Some{b}:
117      b64.same(s, Bytes.slice(b, 0, 4294967295))
118
119# Padded standard base64, only in its canonical text: Bytes.from_base64 alone accepts nonzero pad bits.
120def b64(+s: String) -> Maybe<&1, Bytes.Bytes>:
121  b64.canon(s, Bytes.from_base64(s))
122
123# '=' up to a multiple of four chars.
124def pad(+s: String) -> String:
125  +r = (String.length(s) % 4n : Nat)
126  s ++ Bool.pick(String, Nat.is_eq(r, 2n), "==", Bool.pick(String, Nat.is_eq(r, 3n), "=", ""))
127
128def nonempty.of(b: Bytes.Bytes) -> Maybe<&1, Bytes.Bytes>:
129  Bytes.Bytes{+n, a} = b
130  Bool.pick(Maybe<&1, Bytes.Bytes>, U32.is_eq(n, 0), None{}, Some{Bytes.Bytes{n, a}})
131
132def nonempty(m: Maybe<&1, Bytes.Bytes>) -> Maybe<&1, Bytes.Bytes>:
133  match m:
134    case None{}:
135      None{}
136    case Some{b}:
137      nonempty.of(b)
138
139# A Standard Webhooks secret: whsec_ then base64 of the key, padded or not. The prefix is optional.
140def key.std(+s: String) -> Maybe<&1, Bytes.Bytes>:
141  nonempty(b64(pad(Bool.pick(String, String.starts_with(s, "whsec_"), String.drop(s, 6n), s))))
142
143# std: a Standard Webhooks secret. Otherwise the secret's UTF-8 is the key, as Stripe and GitHub use it.
144def key(+std: Bool, +s: String) -> Maybe<&1, Bytes.Bytes>:
145  match std:
146    case True{}:
147      key.std(s)
148    case False{}:
149      nonempty(Some{Enc.utf8.encode(s)})
150
151# A signature's octets: hex (Stripe, GitHub) or canonical base64 (Standard Webhooks).
152def decode(+hex: Bool, +s: String) -> Maybe<&1, Bytes.Bytes>:
153  match hex:
154    case True{}:
155      Bytes.from_hex(s)
156    case False{}:
157      b64(s)
158
159def mac.of(r: Result<&1, &1, U32 & String, U32 & Array<U32>>) -> Result<&1, &1, Err, Bytes.Bytes>:
160  match r:
161    case Fail{(c, w)}:
162      Fail{CryptoErr{c, w}}
163    case Done{(n, b)}:
164      Done{Bytes.Bytes{n, b}}
165
166def mac(k: Bytes.Bytes, data: Bytes.Bytes) -> IO(Result<&1, &1, Err, Bytes.Bytes>):
167  Bytes.Bytes{+kn, kb} = k
168  Bytes.Bytes{+dn, db} = data
169  do IO<Result<&1, &1, Err, Bytes.Bytes>>:
170    r : Result<&1, &1, U32 & String, U32 & Array<U32>> <- Crypto.hmac.words("SHA256", kn, kb, dn, db)
171    return mac.of(r)
172
173def ct.go(m: Bytes.Bytes, s: Bytes.Bytes) -> IO(Bool):
174  Bytes.Bytes{+mn, mb} = m
175  Bytes.Bytes{+sn, sb} = s
176  Crypto.eq.ct.words(mn, mb, sn, sb)
177
178# A signature that does not decode matches nothing.
179def ct(s: Maybe<&1, Bytes.Bytes>, m: Bytes.Bytes) -> IO(Bool):
180  match s:
181    case None{}:
182      IO.pure(Bool, False{})
183    case Some{b}:
184      ct.go(m, b)
185
186# Does any signature equal the MAC? r holds the MAC and a copy; every signature is compared.
187def any.sig(sigs: List<&2, String>, +hex: Bool, r: Bytes.Bytes & Bytes.Bytes) -> IO(Bool):
188  match sigs:
189    case Nil{}:
190      IO.pure(Bool, False{})
191    case Con{s, t}:
192      (m1, m2) = r
193      do IO<Bool>:
194        ok : Bool <- ct(decode(hex, s), m2)
195        rest : Bool <- any.sig(t, hex, Bytes.slice(m1, 0, 4294967295))
196        return Bool.or(ok, rest)
197
198def key.cmp(r: Result<&1, &1, Err, Bytes.Bytes>, +hex: Bool, +sigs: List<&2, String>) -> IO(Result<&1, &1, Err, Bool>):
199  match r:
200    case Fail{e}:
201      IO.pure(Result<&1, &1, Err, Bool>, Fail{e})
202    case Done{m}:
203      do IO<Result<&1, &1, Err, Bool>>:
204        ok : Bool <- any.sig(sigs, hex, Bytes.slice(m, 0, 4294967295))
205        return Done{ok}
206
207def key.check(k: Maybe<&1, Bytes.Bytes>, +hex: Bool, +sigs: List<&2, String>, msg: Bytes.Bytes) -> IO(Result<&1, &1, Err, Bool>):
208  match k:
209    case None{}:
210      IO.pure(Result<&1, &1, Err, Bool>, Fail{BadSecret{}})
211    case Some{b}:
212      do IO<Result<&1, &1, Err, Bool>>:
213        r : Result<&1, &1, Err, Bytes.Bytes> <- mac(b, msg)
214        key.cmp(r, hex, sigs)
215
216def both.done(+x: Bool, b: Result<&1, &1, Err, Bool>) -> Result<&1, &1, Err, Bool>:
217  match b:
218    case Fail{e}:
219      Fail{e}
220    case Done{y}:
221      Done{Bool.or(x, y)}
222
223# A bad secret fails the check, even when another secret matches.
224def both(a: Result<&1, &1, Err, Bool>, b: Result<&1, &1, Err, Bool>) -> Result<&1, &1, Err, Bool>:
225  match a:
226    case Fail{e}:
227      Fail{e}
228    case Done{x}:
229      both.done(x, b)
230
231# Does any signature sign the message under any secret? r holds the message and a copy.
232def any.key(keys: List<&2, String>, +std: Bool, +hex: Bool, +sigs: List<&2, String>, r: Bytes.Bytes & Bytes.Bytes) ->
233    IO(Result<&1, &1, Err, Bool>):
234  match keys:
235    case Nil{}:
236      IO.pure(Result<&1, &1, Err, Bool>, Done{False{}})
237    case Con{k, t}:
238      (m1, m2) = r
239      do IO<Result<&1, &1, Err, Bool>>:
240        a : Result<&1, &1, Err, Bool> <- key.check(key(std, k), hex, sigs, m2)
241        b : Result<&1, &1, Err, Bool> <- any.key(t, std, hex, sigs, Bytes.slice(m1, 0, 4294967295))
242        return both(a, b)
243
244def found(-A: Data, r: Result<&1, &1, Err, Bool>, v: A) -> Result<&1, &1, Err, A>:
245  match r:
246    case Fail{e}:
247      Fail{e}
248    case Done{ok}:
249      Bool.pick(Result<&1, &1, Err, A>, ok, Done{v}, Fail{NoMatch{}})
250
251# The body back beside a failure.
252def back(-A: Data, r: Bytes.Bytes & Bytes.Bytes, e: Err) -> IO(Bytes.Bytes & Result<&1, &1, Err, A>):
253  (keep, copy) = r
254  IO.pure(Bytes.Bytes & Result<&1, &1, Err, A>, (keep, Fail{e}))
255
256def run.mac(-A: Data, v: A, pre: String, +sigs: List<&2, String>, +std: Bool, +hex: Bool, secrets: List<&2, String>,
257    r: Bytes.Bytes & Bytes.Bytes) -> IO(Bytes.Bytes & Result<&1, &1, Err, A>):
258  (keep, copy) = r
259  do IO<Bytes.Bytes & Result<&1, &1, Err, A>>:
260    hit : Result<&1, &1, Err, Bool> <-
261      any.key(secrets, std, hex, sigs, Bytes.slice(Bytes.append(Bytes.from_string(pre), copy), 0, 4294967295))
262    return (keep, found(A, hit, v))
263
264# c: the header checks' answer, the signed prefix before the body, and the candidate signatures.
265def run(-A: Data, c: Result<&1, &1, Err, A & String & List<&2, String>>, +std: Bool, +hex: Bool, secrets: List<&2, String>,
266    r: Bytes.Bytes & Bytes.Bytes) -> IO(Bytes.Bytes & Result<&1, &1, Err, A>):
267  match c:
268    case Fail{e}:
269      back(A, r, e)
270    case Done{(v, pre, sigs)}:
271      run.mac(A, v, pre, sigs, std, hex, secrets, r)
272
273# ---- Standard Webhooks (https://www.standardwebhooks.com)
274
275# The v1 entries of a space-separated webhook-signature; other versions are skipped.
276def std.sigs(xs: List<&2, String>) -> List<&2, String>:
277  match xs:
278    case Nil{}:
279      Nil{}
280    case Con{x, t}:
281      push(strip("v1,", x), std.sigs(t))
282
283def std.check(+tol: U32, now: Time.Instant, +h: Map<&2, List<&2, String>>) -> Result<&1, &1, Err, String & String & List<&2, String>>:
284  do Result<&1, &1, Err, String & String & List<&2, String>>:
285    +id : String <- need("webhook-id", field(h, "webhook-id"))
286    +ts : String <- need("webhook-timestamp", field(h, "webhook-timestamp"))
287    sig : String <- need("webhook-signature", field(h, "webhook-signature"))
288    u : Unit <- id.check(id)
289    t : Int.I64 <- ts.read(ts)
290    w : Unit <- window(tol, now, t)
291    return (id, id ++ "." ++ ts ++ ".", std.sigs(String.split(sig, ' ')))
292
293# Done with the webhook-id when a v1 signature in webhook-signature signs id.timestamp.body under a secret,
294# and webhook-timestamp is within tol seconds of now.
295def verify.with(+tol: U32, secrets: List<&2, String>, now: Time.Instant, +headers: Map<&2, List<&2, String>>, body: Bytes.Bytes) ->
296    IO(Bytes.Bytes & Result<&1, &1, Err, String>):
297  run(String, std.check(tol, now, headers), True{}, False{}, secrets, Bytes.slice(body, 0, 4294967295))
298
299# verify.with a 300 s tolerance.
300def verify(secrets: List<&2, String>, now: Time.Instant, +headers: Map<&2, List<&2, String>>, body: Bytes.Bytes) ->
301    IO(Bytes.Bytes & Result<&1, &1, Err, String>):
302  verify.with(300, secrets, now, headers, body)
303
304def sign.check(+id: String, +ts: Int.I64) -> Result<&1, &1, Err, String & String>:
305  do Result<&1, &1, Err, String & String>:
306    u : Unit <- id.check(id)
307    w : Unit <- Bool.pick(Result<&1, &1, Err, Unit>, Int.I64.is_neg(ts), Fail{BadTimestamp{}}, Done{Unit{}})
308    return (id, Int.I64.show(ts))
309
310def sign.headers(+id: String, +ts: String, m: Result<&1, &1, Err, Bytes.Bytes>) -> Result<&1, &1, Err, Map<&2, List<&2, String>>>:
311  match m:
312    case Fail{e}:
313      Fail{e}
314    case Done{s}:
315      Done{put(put(put(Map.new(&2, List<&2, String>), "webhook-id", id), "webhook-timestamp", ts), "webhook-signature", "v1," ++ Bytes.to_base64(s))}
316
317def sign.mac(k: Bytes.Bytes, +id: String, +ts: String, r: Bytes.Bytes & Bytes.Bytes) ->
318    IO(Bytes.Bytes & Result<&1, &1, Err, Map<&2, List<&2, String>>>):
319  (keep, copy) = r
320  do IO<Bytes.Bytes & Result<&1, &1, Err, Map<&2, List<&2, String>>>>:
321    m : Result<&1, &1, Err, Bytes.Bytes> <- mac(k, Bytes.append(Bytes.from_string(id ++ "." ++ ts ++ "."), copy))
322    return (keep, sign.headers(id, ts, m))
323
324def sign.key(k: Maybe<&1, Bytes.Bytes>, +id: String, +ts: String, r: Bytes.Bytes & Bytes.Bytes) ->
325    IO(Bytes.Bytes & Result<&1, &1, Err, Map<&2, List<&2, String>>>):
326  match k:
327    case None{}:
328      back(Map<&2, List<&2, String>>, r, BadSecret{})
329    case Some{b}:
330      sign.mac(b, id, ts, r)
331
332def sign.go(c: Result<&1, &1, Err, String & String>, +secret: String, r: Bytes.Bytes & Bytes.Bytes) ->
333    IO(Bytes.Bytes & Result<&1, &1, Err, Map<&2, List<&2, String>>>):
334  match c:
335    case Fail{e}:
336      back(Map<&2, List<&2, String>>, r, e)
337    case Done{(id, ts)}:
338      sign.key(key.std(secret), id, ts, r)
339
340# The webhook-id, webhook-timestamp, and webhook-signature ("v1,<base64 MAC>") headers for body.
341# id: not empty, no '.'. ts: unix seconds, not negative. secret: whsec_<base64>; send the prefix.
342def sign(+id: String, +ts: Int.I64, body: Bytes.Bytes, +secret: String) ->
343    IO(Bytes.Bytes & Result<&1, &1, Err, Map<&2, List<&2, String>>>):
344  sign.go(sign.check(id, ts), secret, Bytes.slice(body, 0, 4294967295))
345
346# ---- Stripe (https://docs.stripe.com/webhooks#verify-manually)
347
348def stripe.t(s: String, r: List<&2, String> & List<&2, String>) -> List<&2, String> & List<&2, String>:
349  (ts, vs) = r
350  (Con{s, ts}, vs)
351
352def stripe.v.push(s: String, r: List<&2, String> & List<&2, String>) -> List<&2, String> & List<&2, String>:
353  (ts, vs) = r
354  (ts, Con{s, vs})
355
356def stripe.v(m: Maybe<&2, String>, r: List<&2, String> & List<&2, String>) -> List<&2, String> & List<&2, String>:
357  match m:
358    case None{}:
359      r
360    case Some{s}:
361      stripe.v.push(s, r)
362
363def stripe.item(t: Maybe<&2, String>, v: Maybe<&2, String>, r: List<&2, String> & List<&2, String>) ->
364    List<&2, String> & List<&2, String>:
365  match t:
366    case None{}:
367      stripe.v(v, r)
368    case Some{s}:
369      stripe.t(s, r)
370
371# The t= and v1= values of comma-separated items; other schemes (v0) are skipped.
372def stripe.items(xs: List<&2, String>) -> List<&2, String> & List<&2, String>:
373  match xs:
374    case Nil{}:
375      (Nil{}, Nil{})
376    case Con{+x, rest}:
377      stripe.item(strip("t=", x), strip("v1=", x), stripe.items(rest))
378
379def stripe.single(ts: List<&2, String>, vs: List<&2, String>) -> Result<&1, &1, Err, String & List<&2, String>>:
380  match ts:
381    case Nil{}:
382      Fail{BadTimestamp{}}
383    case Con{t, Nil{}}:
384      Done{(t, vs)}
385    case Con{t, more}:
386      Fail{BadTimestamp{}}
387
388# Exactly one t=: a second one would leave the signed timestamp ambiguous.
389def stripe.one(r: List<&2, String> & List<&2, String>) -> Result<&1, &1, Err, String & List<&2, String>>:
390  (ts, vs) = r
391  stripe.single(ts, vs)
392
393def stripe.when(+tol: U32, now: Time.Instant, p: String & List<&2, String>) -> Result<&1, &1, Err, Unit & String & List<&2, String>>:
394  (+ts, vs) = p
395  do Result<&1, &1, Err, Unit & String & List<&2, String>>:
396    t : Int.I64 <- ts.read(ts)
397    w : Unit <- window(tol, now, t)
398    return (Unit{}, ts ++ ".", vs)
399
400def stripe.check(+tol: U32, now: Time.Instant, +h: Map<&2, List<&2, String>>) -> Result<&1, &1, Err, Unit & String & List<&2, String>>:
401  do Result<&1, &1, Err, Unit & String & List<&2, String>>:
402    sig : String <- need("stripe-signature", field(h, "stripe-signature"))
403    p : String & List<&2, String> <- stripe.one(stripe.items(String.split(sig, ',')))
404    stripe.when(tol, now, p)
405
406# Done when a v1 hex signature in stripe-signature signs t.body under a secret (the whsec_ text itself, as UTF-8),
407# and t is within tol seconds of now.
408def stripe.verify.with(+tol: U32, secrets: List<&2, String>, now: Time.Instant, +headers: Map<&2, List<&2, String>>, body: Bytes.Bytes) ->
409    IO(Bytes.Bytes & Result<&1, &1, Err, Unit>):
410  run(Unit, stripe.check(tol, now, headers), False{}, True{}, secrets, Bytes.slice(body, 0, 4294967295))
411
412# stripe.verify.with a 300 s tolerance, Stripe's default.
413def stripe.verify(secrets: List<&2, String>, now: Time.Instant, +headers: Map<&2, List<&2, String>>, body: Bytes.Bytes) ->
414    IO(Bytes.Bytes & Result<&1, &1, Err, Unit>):
415  stripe.verify.with(300, secrets, now, headers, body)
416
417# ---- GitHub (https://docs.github.com/en/webhooks/using-webhooks/validating-webhook-deliveries)
418
419def github.check(+h: Map<&2, List<&2, String>>) -> Result<&1, &1, Err, Unit & String & List<&2, String>>:
420  do Result<&1, &1, Err, Unit & String & List<&2, String>>:
421    sig : String <- need("x-hub-signature-256", field(h, "x-hub-signature-256"))
422    return (Unit{}, "", push(strip("sha256=", sig), Nil{}))
423
424# Done when x-hub-signature-256 is sha256=<hex> of the body under a secret's UTF-8. GitHub signs no timestamp.
425def github.verify(secrets: List<&2, String>, +headers: Map<&2, List<&2, String>>, body: Bytes.Bytes) ->
426    IO(Bytes.Bytes & Result<&1, &1, Err, Unit>):
427  run(Unit, github.check(headers), False{}, True{}, secrets, Bytes.slice(body, 0, 4294967295))
428
429type SendErr is Data:
430  SendSign{err: Err}
431  SendNet{err: Hairpin.Err}
432
433def send.result(x: Hairpin.Client & Retry.Budget & Result<&1, &1, Hairpin.Err, Http.Res>) ->
434    Hairpin.Client & Retry.Budget & Result<&1, &1, SendErr, Http.Res>:
435  (c, b, r) = x
436  match r:
437    case Fail{e}:
438      (c, b, Fail{SendNet{e}})
439    case Done{res}:
440      (c, b, Done{res})
441
442# A timeout, a refused connect, 408, 429, or any 5xx may clear.
443def send.again(r: Result<&1, &1, Http.Err, Http.Res>) ->
444    Result<&1, &1, Http.Err, Http.Res> & Maybe<&2, String>:
445  match r:
446    case Fail{e}:
447      Http.retry.judge(True{}, Fail{e})
448    case Done{res}:
449      Http.Res{+status, +headers, body} = res
450      +again = Bool.or(Http.retry.status(status), U32.is_eq((status / 100 : U32), 5))
451      (Done{Http.Res{status, headers, body}}, Bool.pick(Maybe<&2, String>, again, Some{Http.header(headers, "retry-after")}, None{}))
452
453def send.judge(r: Result<&1, &1, Http.Err, Http.Res>) -> Result<&1, &1, Http.Err, Http.Res> & Hairpin.Verdict:
454  Hairpin.judge.of(send.again(r))
455
456# Receivers deduplicate on the event ID, so the POST is safe to repeat.
457def send.signed(c: Hairpin.Client, b: Retry.Budget, +url: String, r: Bytes.Bytes & Result<&1, &1, Err, Map<&2, List<&2, String>>>) ->
458    IO(Hairpin.Client & Retry.Budget & Result<&1, &1, SendErr, Http.Res>):
459  (body, signed) = r
460  match signed:
461    case Fail{e}:
462      IO.pure(Hairpin.Client & Retry.Budget & Result<&1, &1, SendErr, Http.Res>, (c, b, Fail{SendSign{e}}))
463    case Done{+h}:
464      do IO<Hairpin.Client & Retry.Budget & Result<&1, &1, SendErr, Http.Res>>:
465        enc : String <- Http.codings()
466        x : Hairpin.Client & Retry.Budget & Result<&1, &1, Hairpin.Err, Http.Res> <-
467          Hairpin.request.as(~send.judge, Hairpin.redirect(c, Http.ModeManual{}), b, True{}, enc, "POST", url,
468            Http.set(h, "content-type", "application/json"), body)
469        return send.result(x)
470
471def send.at(c: Hairpin.Client, b: Retry.Budget, url: String, id: String, secret: String, body: Bytes.Bytes, now: Time.Instant) ->
472    IO(Hairpin.Client & Retry.Budget & Result<&1, &1, SendErr, Http.Res>):
473  match now:
474    case Time.Instant{secs, nanos}:
475      do IO<Hairpin.Client & Retry.Budget & Result<&1, &1, SendErr, Http.Res>>:
476        signed : Bytes.Bytes & Result<&1, &1, Err, Map<&2, List<&2, String>>> <- sign(id, secs, body, secret)
477        send.signed(c, b, url, signed)
478
479# One event and one signature per delivery, inside a caller's retry layer. Every attempt takes from b and
480# reuses this event ID, timestamp, headers, and raw body; the client's retry setting caps this delivery.
481# The budget left comes back: pass it to the next delivery of the same operation.
482def send.in(c: Hairpin.Client, b: Retry.Budget, url: String, id: String, secret: String, body: Bytes.Bytes) ->
483    IO(Hairpin.Client & Retry.Budget & Result<&1, &1, SendErr, Http.Res>):
484  do IO<Hairpin.Client & Retry.Budget & Result<&1, &1, SendErr, Http.Res>>:
485    now : Time.Instant <- Time.now()
486    send.at(c, b, url, id, secret, body, now)
487
488def send.drop(x: Hairpin.Client & Retry.Budget & Result<&1, &1, SendErr, Http.Res>) -> Hairpin.Client & Result<&1, &1, SendErr, Http.Res>:
489  (c, b, r) = x
490  (c, r)
491
492def send.budget(url: String, id: String, secret: String, body: Bytes.Bytes, y: Hairpin.Client & Retry.Budget) ->
493    IO(Hairpin.Client & Retry.Budget & Result<&1, &1, SendErr, Http.Res>):
494  (c, b) = y
495  send.in(c, b, url, id, secret, body)
496
497# n extra attempts, on a budget of n + 1 and the client's deadline, with Hairpin's backoff. The client comes back with retry n.
498def send.with(+n: U32, c: Hairpin.Client, url: String, id: String, secret: String, body: Bytes.Bytes) ->
499    IO(Hairpin.Client & Result<&1, &1, SendErr, Http.Res>):
500  do IO<Hairpin.Client & Result<&1, &1, SendErr, Http.Res>>:
501    y : Hairpin.Client & Retry.Budget <- Hairpin.budget(Hairpin.retry(c, n))
502    x : Hairpin.Client & Retry.Budget & Result<&1, &1, SendErr, Http.Res> <- send.budget(url, id, secret, body, y)
503    return send.drop(x)
504
505# Three extra attempts by default.
506def send(c: Hairpin.Client, url: String, id: String, secret: String, body: Bytes.Bytes) ->
507    IO(Hairpin.Client & Result<&1, &1, SendErr, Http.Res>):
508  send.with(3, c, url, id, secret, body)