1	# OAuth 2.0 client credentials, refresh, and authorization code with PKCE over Hairpin. Source: https://github.com/paymog/bend-kit/tree/main/oauth2
2	import Base
3	import bend-kit-crypto@0.2.2.1/crypto.bend as Crypto
4	import bend-kit-hairpin@0.4.0.0/hairpin.bend as Hairpin
5	import bend-kit-http@0.32.0.0/http.bend as Http
6	import bend-kit-time@0.1.2.1/time.bend as Time
7	# By hash, as hairpin imports them: bend-kit-url@0.4.1.0, -json@0.5.0.1, -encoding@0.3.0.0, -bytes@0.3.0.0.
8	import 0x1f2d80f53f971b16c6de6a65cb1918ae/url.bend as Url
9	import 0x584fc27920487ceab242392391418d7f/json.bend as Json
10	import 0xcfc8be7b076f41f95c8e118383892d55/encoding.bend as Enc
11	import 0x49814d83de8f70993a43e1002be29ecd/bytes.bend as Bytes
12	
13	# RFC 6749 and RFC 7636. Text is a String of code points; form values go out as UTF-8.
14	# token: the token endpoint URL. secret: "" for a public client, which sends client_id in the body;
15	# a confidential client authenticates with HTTP Basic (RFC 6749 §2.3.1).
16	type Config is Data:
17	  Config{token: String, id: String, secret: String}
18	
19	# kind: token_type, as "Bearer". refresh: "" for none. scope: "" when the server did not say.
20	# expires: when the access token lapses, counted from just before the request; None without expires_in.
21	type Token is Data:
22	  Token{access: String, kind: String, refresh: String, scope: String, expires: Maybe<&2, Time.Instant>}
23	
24	# ErrNet: the request did not complete. ErrOAuth: an RFC 6749 §5.2 error with its status, or a §4.1.2.1
25	# error in a callback, status 0. ErrReply: not a Bearer token response, with its status and text. ErrState: the
26	# callback's state is not ours (§10.12). ErrCrypto: the random source or SHA-256 failed. ErrExpired: the
27	# token lapsed and has no refresh token.
28	type Err is Data:
29	  ErrNet{e: Hairpin.Err}
30	  ErrOAuth{status: U32, code: String, why: String}
31	  ErrReply{status: U32, body: String}
32	  ErrState{}
33	  ErrCrypto{code: U32, why: String}
34	  ErrExpired{}
35	
36	# ---- base64url
37	
38	def b64url.ch(+c: U32, t: String) -> String:
39	  match c:
40	    case 43:
41	      SCon{Chr{45}, t}
42	    case 47:
43	      SCon{Chr{95}, t}
44	    case 61:
45	      t
46	    case _:
47	      SCon{Chr{c}, t}
48	
49	def b64url.go(s: String) -> String:
50	  match s:
51	    case SNil{}:
52	      SNil{}
53	    case SCon{Chr{+c}, t}:
54	      b64url.ch(c, b64url.go(t))
55	
56	# Base64url without padding (RFC 4648 §5, RFC 7636 Appendix A).
57	def b64url(b: Bytes.Bytes) -> String:
58	  b64url.go(Bytes.to_base64(b))
59	
60	# ---- forms
61	
62	def utf8(+s: String) -> String:
63	  Bytes.to_string(Enc.utf8.encode(s))
64	
65	def field(m: Map<&2, String>, k: String, +v: String) -> Map<&2, String>:
66	  Map.set(&2, String, m, k, utf8(v))
67	
68	def scoped(+scope: String, +m: Map<&2, String>) -> Map<&2, String>:
69	  Bool.pick(Map<&2, String>, String.is_empty(scope), m, field(m, "scope", scope))
70	
71	def form(+k: String, +v: String) -> Map<&2, String>:
72	  field(Map.new(&2, String), k, v)
73	
74	# RFC 6749 §2.3.1: id and secret are form-encoded before base64.
75	def basic(+id: String, +secret: String) -> String:
76	  "Basic " ++ Bytes.to_base64(Bytes.from_string(Url.pct.encode_q(utf8(id)) ++ ":" ++ Url.pct.encode_q(utf8(secret))))
77	
78	def auth.headers(+id: String, +secret: String) -> Map<&2, List<&2, String>>:
79	  +h = Http.set(Http.set(Http.empty(), "content-type", "application/x-www-form-urlencoded"), "accept", "application/json")
80	  Bool.pick(Map<&2, List<&2, String>>, String.is_empty(secret), h, Http.set(h, "authorization", basic(id, secret)))
81	
82	def auth.body(+id: String, +secret: String, +m: Map<&2, String>) -> Map<&2, String>:
83	  Bool.pick(Map<&2, String>, String.is_empty(secret), field(m, "client_id", id), m)
84	
85	# The form body of a token request from cfg's client.
86	def body(+id: String, +secret: String, m: Map<&2, String>) -> String:
87	  Url.form(auth.body(id, secret, m))
88	
89	# ---- token responses (RFC 6749 §5)
90	
91	type Got is Data:
92	  Got{access: String, kind: String, refresh: String, scope: String, expires: String, error: String, desc: String}
93	
94	def got.put(g: Got, +k: String, +v: String) -> Got:
95	  Got{a, t, r, s, e, er, d} = g
96	  Got{Bool.pick(String, String.eq(k, "access_token"), v, a), Bool.pick(String, String.eq(k, "token_type"), v, t),
97	    Bool.pick(String, String.eq(k, "refresh_token"), v, r), Bool.pick(String, String.eq(k, "scope"), v, s),
98	    Bool.pick(String, String.eq(k, "expires_in"), v, e), Bool.pick(String, String.eq(k, "error"), v, er),
99	    Bool.pick(String, String.eq(k, "error_description"), v, d)}
100	
101	# A string's text, or a number's, as some servers send expires_in as "3600".
102	def got.text(v: Json.Val) -> String:
103	  match v:
104	    case Json.Str{s}:
105	      Enc.utf8.decode(s)
106	    case Json.Num{s}:
107	      Bytes.to_string(s)
108	    case other:
109	      ""
110	
111	def got.go(kvs: List<&1, Bytes.Bytes & Json.Val>, g: Got) -> Got:
112	  match kvs:
113	    case Nil{}:
114	      g
115	    case Con{(k, v), t}:
116	      got.go(t, got.put(g, Bytes.to_string(k), got.text(v)))
117	
118	def got.obj(v: Json.Val) -> Maybe<&2, Got>:
119	  match v:
120	    case Json.Obj{kvs}:
121	      Some{got.go(kvs, Got{"", "", "", "", "", "", ""})}
122	    case other:
123	      None{}
124	
125	def got(m: Maybe<&1, Json.Val>) -> Maybe<&2, Got>:
126	  match m:
127	    case None{}:
128	      None{}
129	    case Some{v}:
130	      got.obj(v)
131	
132	def expiry(now: Time.Instant, m: Maybe<&2, U32>) -> Maybe<&2, Time.Instant>:
133	  match m:
134	    case None{}:
135	      None{}
136	    case Some{n}:
137	      Some{Time.Instant.add(now, Time.Duration.of_secs(Time.i64(n)))}
138	
139	# A 2xx with an access token of type Bearer (RFC 6750 §4, case-insensitive), the only kind request sends.
140	def good(+status: U32, g: Got) -> Bool:
141	  Got{a, t, r, s, e, er, d} = g
142	  Bool.and(Bool.and(U32.is_le(200, status), U32.is_lt(status, 300)), Bool.and(Bool.not(String.is_empty(a)), String.eq(String.to_lower(t), "bearer")))
143	
144	# §6: a refresh reply without refresh_token keeps the old one. b: the body, decoded only for an error.
145	def token.pick(ok: Bool, +status: U32, +old: String, now: Time.Instant, b: Bytes.Bytes, g: Got) -> Result<&1, &1, Err, Token>:
146	  match ok:
147	    case True{}:
148	      Got{a, t, +r, s, e, er, d} = g
149	      Done{Token{a, t, Bool.pick(String, String.is_empty(r), old, r), s, expiry(now, Json.u32.num(e))}}
150	    case False{}:
151	      Got{a, t, r, s, e, +er, d} = g
152	      Fail{Bool.pick(Err, String.is_empty(er), ErrReply{status, Enc.utf8.decode(b)}, ErrOAuth{status, er, d})}
153	
154	def token.of(+status: U32, +old: String, now: Time.Instant, b: Bytes.Bytes, m: Maybe<&2, Got>) -> Result<&1, &1, Err, Token>:
155	  match m:
156	    case None{}:
157	      Fail{ErrReply{status, Enc.utf8.decode(b)}}
158	    case Some{+g}:
159	      token.pick(good(status, g), status, old, now, b, g)
160	
161	def parse.copy(+status: U32, +old: String, now: Time.Instant, r: Bytes.Bytes & Bytes.Bytes) -> Result<&1, &1, Err, Token>:
162	  (b, c) = r
163	  token.of(status, old, now, b, got(Json.parse.bytes(c)))
164	
165	# A token endpoint's reply at status, requested at now. old: the refresh token to keep when none comes back.
166	def parse(+status: U32, +old: String, now: Time.Instant, b: Bytes.Bytes) -> Result<&1, &1, Err, Token>:
167	  parse.copy(status, old, now, Bytes.slice(b, 0, 4294967295))
168	
169	def reply(+old: String, now: Time.Instant, r: Result<&1, &1, Hairpin.Err, Http.Res>) -> Result<&1, &1, Err, Token>:
170	  match r:
171	    case Fail{e}:
172	      Fail{ErrNet{e}}
173	    case Done{res}:
174	      Http.Res{+status, h, b} = res
175	      parse(status, old, now, b)
176	
177	def grant.done(+old: String, now: Time.Instant, x: Hairpin.Client & Result<&1, &1, Hairpin.Err, Http.Res>) ->
178	    Hairpin.Client & Result<&1, &1, Err, Token>:
179	  (h, r) = x
180	  (h, reply(old, now, r))
181	
182	# POST m to the token endpoint. Hairpin sends a POST once.
183	def grant(h: Hairpin.Client, cfg: Config, m: Map<&2, String>, +old: String) -> IO(Hairpin.Client & Result<&1, &1, Err, Token>):
184	  Config{url, +id, +secret} = cfg
185	  do IO<Hairpin.Client & Result<&1, &1, Err, Token>>:
186	    now : Time.Instant <- Time.now()
187	    x : Hairpin.Client & Result<&1, &1, Hairpin.Err, Http.Res> <-
188	      Hairpin.request(h, "POST", url, auth.headers(id, secret), Http.from_string(body(id, secret, m)))
189	    return grant.done(old, now, x)
190	
191	# ---- grants
192	
193	# RFC 6749 §4.4. scope: "" for the server's default.
194	def client_credentials(h: Hairpin.Client, cfg: Config, +scope: String) -> IO(Hairpin.Client & Result<&1, &1, Err, Token>):
195	  grant(h, cfg, scoped(scope, form("grant_type", "client_credentials")), "")
196	
197	# RFC 6749 §4.1.3 with RFC 7636 §4.5: the code from callback, the same redirect_uri, and the verifier.
198	def code(h: Hairpin.Client, cfg: Config, +code: String, +redirect: String, +verifier: String) ->
199	    IO(Hairpin.Client & Result<&1, &1, Err, Token>):
200	  grant(h, cfg, field(field(field(form("grant_type", "authorization_code"), "code", code), "redirect_uri", redirect), "code_verifier", verifier), "")
201	
202	def refresh.go(none: Bool, h: Hairpin.Client, cfg: Config, +r: String, +scope: String) -> IO(Hairpin.Client & Result<&1, &1, Err, Token>):
203	  match none:
204	    case True{}:
205	      IO.pure(Hairpin.Client & Result<&1, &1, Err, Token>, (h, Fail{ErrExpired{}}))
206	    case False{}:
207	      grant(h, cfg, scoped(scope, field(form("grant_type", "refresh_token"), "refresh_token", r)), r)
208	
209	# RFC 6749 §6. scope: "" keeps the granted scope. ErrExpired when tok has no refresh token.
210	def refresh(h: Hairpin.Client, cfg: Config, tok: Token, +scope: String) -> IO(Hairpin.Client & Result<&1, &1, Err, Token>):
211	  Token{a, k, +r, s, e} = tok
212	  refresh.go(String.is_empty(r), h, cfg, r, scope)
213	
214	def expiring.at(e: Maybe<&2, Time.Instant>, now: Time.Instant, +skew: U32) -> Bool:
215	  match e:
216	    case None{}:
217	      False{}
218	    case Some{at}:
219	      Bool.not(Cmp.is_lt(Time.Instant.cmp(Time.Instant.add(now, Time.Duration.of_secs(Time.i64(skew))), at)))
220	
221	# Does tok lapse within skew seconds of now? A token without expires_in never does.
222	def expiring(tok: Token, now: Time.Instant, +skew: U32) -> Bool:
223	  Token{a, k, r, s, e} = tok
224	  expiring.at(e, now, skew)
225	
226	def fresh.go(due: Bool, h: Hairpin.Client, cfg: Config, +tok: Token) -> IO(Hairpin.Client & Result<&1, &1, Err, Token>):
227	  match due:
228	    case True{}:
229	      refresh(h, cfg, tok, "")
230	    case False{}:
231	      IO.pure(Hairpin.Client & Result<&1, &1, Err, Token>, (h, Done{tok}))
232	
233	# tok, or a refreshed one when it lapses within skew seconds.
234	def fresh(h: Hairpin.Client, cfg: Config, +tok: Token, +skew: U32) -> IO(Hairpin.Client & Result<&1, &1, Err, Token>):
235	  do IO<Hairpin.Client & Result<&1, &1, Err, Token>>:
236	    now : Time.Instant <- Time.now()
237	    fresh.go(expiring(tok, now, skew), h, cfg, tok)
238	
239	def fresh.cc.go(due: Bool, h: Hairpin.Client, cfg: Config, +scope: String, +tok: Token) -> IO(Hairpin.Client & Result<&1, &1, Err, Token>):
240	  match due:
241	    case True{}:
242	      client_credentials(h, cfg, scope)
243	    case False{}:
244	      IO.pure(Hairpin.Client & Result<&1, &1, Err, Token>, (h, Done{tok}))
245	
246	# tok, or a new client-credentials token when it lapses within skew seconds (§4.4.3: no refresh token).
247	def fresh.cc(h: Hairpin.Client, cfg: Config, +scope: String, +tok: Token, +skew: U32) -> IO(Hairpin.Client & Result<&1, &1, Err, Token>):
248	  do IO<Hairpin.Client & Result<&1, &1, Err, Token>>:
249	    now : Time.Instant <- Time.now()
250	    fresh.cc.go(expiring(tok, now, skew), h, cfg, scope, tok)
251	
252	# ---- authorization code with PKCE (RFC 7636)
253	
254	def random.of(r: Result<&1, &1, U32 & String, U32 & Array<U32>>) -> Result<&1, &1, Err, String>:
255	  match r:
256	    case Fail{(c, why)}:
257	      Fail{ErrCrypto{c, why}}
258	    case Done{(len, buf)}:
259	      Done{b64url(Bytes.Bytes{len, buf})}
260	
261	# n octets from the OS secure random source, as base64url.
262	def random(+n: U32) -> IO(Result<&1, &1, Err, String>):
263	  do IO<Result<&1, &1, Err, String>>:
264	    r : Result<&1, &1, U32 & String, U32 & Array<U32>> <- Crypto.random.words(n)
265	    return random.of(r)
266	
267	# §4.1: 32 random octets, 43 unreserved chars.
268	def verifier() -> IO(Result<&1, &1, Err, String>):
269	  random(32)
270	
271	# An unguessable state for the authorization request (RFC 6749 §10.12).
272	def state() -> IO(Result<&1, &1, Err, String>):
273	  random(16)
274	
275	def challenge.words(b: Bytes.Bytes) -> IO(Result<&1, &1, Err, String>):
276	  Bytes.Bytes{+len, buf} = b
277	  do IO<Result<&1, &1, Err, String>>:
278	    r : Result<&1, &1, U32 & String, U32 & Array<U32>> <- Crypto.sha256.words(len, buf)
279	    return random.of(r)
280	
281	# §4.2 S256: BASE64URL(SHA256(ASCII(verifier))).
282	def challenge(+verifier: String) -> IO(Result<&1, &1, Err, String>):
283	  challenge.words(Bytes.from_string(verifier))
284	
285	def qmark(s: String) -> Bool:
286	  match s:
287	    case SNil{}:
288	      False{}
289	    case SCon{Chr{+c}, t}:
290	      Bool.or(U32.is_eq(c, 63), qmark(t))
291	
292	# RFC 6749 §4.1.1 with RFC 7636 §4.3: the URL to send the user to. endpoint may carry its own query.
293	def authorize.url(cfg: Config, +endpoint: String, +redirect: String, +scope: String, +state: String, +challenge: String) -> String:
294	  Config{t, +id, s} = cfg
295	  +q = field(field(field(field(field(form("response_type", "code"), "client_id", id), "redirect_uri", redirect), "state", state),
296	    "code_challenge", challenge), "code_challenge_method", "S256")
297	  endpoint ++ Bool.pick(String, qmark(endpoint), "&", "?") ++ Url.form(scoped(scope, q))
298	
299	def param.of(r: Map<&2, String> & String) -> String:
300	  (n, v) = r
301	  v
302	
303	def param(+m: Map<&2, String>, k: String) -> String:
304	  param.of(Map.get(String, "", m, k))
305	
306	def callback.pick(+err: String, desc: String, +got: String, +code: String, +state: String) -> Result<&1, &1, Err, String>:
307	  Bool.pick(Result<&1, &1, Err, String>, Bool.not(String.eq(got, state)), Fail{ErrState{}},
308	    Bool.pick(Result<&1, &1, Err, String>, Bool.not(String.is_empty(err)), Fail{ErrOAuth{0, err, desc}},
309	      Bool.pick(Result<&1, &1, Err, String>, String.is_empty(code), Fail{ErrReply{0, "no code"}}, Done{code})))
310	
311	def callback.m(+state: String, m: Maybe<&2, Url.Url>) -> Result<&1, &1, Err, String>:
312	  match m:
313	    case None{}:
314	      Fail{ErrReply{0, "bad callback query"}}
315	    case Some{Url.Url{p, +q}}:
316	      callback.pick(param(q, "error"), param(q, "error_description"), param(q, "state"), param(q, "code"), state)
317	
318	def callback.frag(+state: String, r: String & String) -> Result<&1, &1, Err, String>:
319	  (q, f) = r
320	  callback.m(state, Url.parse("/?" ++ q))
321	
322	def callback.q(+state: String, r: String & String) -> Result<&1, &1, Err, String>:
323	  (p, rest) = r
324	  callback.frag(state, Url.take_to(rest, 35))
325	
326	# §4.1.2: the code in the redirect to redirect_uri, once its state matches ours; the server's error if it sent one.
327	def callback(url: String, +state: String) -> Result<&1, &1, Err, String>:
328	  callback.q(state, Url.take_to(url, 63))
329	
330	# ---- bearer requests (RFC 6750 §2.1)
331	
332	def bearer(tok: Token, h: Map<&2, List<&2, String>>) -> Map<&2, List<&2, String>>:
333	  Token{a, k, r, s, e} = tok
334	  Http.set(h, "authorization", "Bearer " ++ a)
335	
336	# Hairpin.request with Authorization: Bearer <access>, over any authorization header in headers.
337	def request(c: Hairpin.Client, tok: Token, +method: String, url: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes) ->
338	    IO(Hairpin.Client & Result<&1, &1, Hairpin.Err, Http.Res>):
339	  Hairpin.request(c, method, url, bearer(tok, headers), body)