1	import Base
2	import ../json.bend as Json
3	import ../act.bend as Act
4	import ../store/io.bend as SIo
5	import ./events.bend as Ev
6	import ./state.bend as St
7	import ./freshen.bend as Fr
8	
9	# Accounts whose refresh token is dead sit in autoswitch_state.json's
10	# quarantine until the user logs in again (autoswitch.py _quarantine and
11	# _release_recovered_quarantines).
12	
13	type Rel is Data:
14	  Rel{slot: String, email: String, reason: String}
15	
16	def ActM(-A: Type) -> Type:
17	  Act.of(A)
18	
19	def ActM.pure(-A: Type, x: A) -> Act.of(A):
20	  Act.pure(A, x)
21	
22	def ActM.bind(-A: Type, -B: Type, m: Act.of(A), f: A -> Act.of(B)) -> Act.of(B):
23	  Act.bind(A, B, m, f)
24	
25	def fp_opt2(+empty: Bool, +fp: String) -> Maybe<&2, String>:
26	  match empty:
27	    case True{}:
28	      None{}
29	    case False{}:
30	      Some{fp}
31	
32	def fp_opt(+fp: String) -> Maybe<&2, String>:
33	  fp_opt2(String.is_empty(fp), fp)
34	
35	def write_q(+root: String, +slot: String, +email: String, +reason: String, +ts: String, +fp: String) -> Act.of(Unit):
36	  St.with_state_lock(Unit, root,
37	    do ActM<Unit>:
38	      st : Json.Json <- Act.lift(Json.Json, St.read_state(root))
39	      St.write_state(root, St.quarantine(st, slot, email, reason, ts, fp_opt(fp))))
40	
41	# Put an account in quarantine (stored with the fingerprint of the credential
42	# that died) and answer the event.
43	def quarantine(+root: String, +slot: String, +email: String, +reason: String, +ts: String) -> Act.of(Json.Json):
44	  do ActM<Json.Json>:
45	    creds : String <- SIo.read_cred(root, slot, email)
46	    fp : String <- Act.lift(String, Fr.fingerprint(creds))
47	    write_q(root, slot, email, reason, ts, fp)
48	    return Ev.quarantined(ts, slot, email, reason)
49	
50	# ---- release ---------------------------------------------------------------------------------------------
51	
52	def keep(+m: Maybe<&2, Rel>, +rest: List<&2, Rel>) -> List<&2, Rel>:
53	  match m:
54	    case Some{r}:
55	      r <> rest
56	    case None{}:
57	      rest
58	
59	def replaced(+slot: String, +entry_email: String) -> Maybe<&2, Rel>:
60	  Some{Rel{slot, entry_email, "account-replaced"}}
61	
62	def changed(+differs: Bool, +slot: String, +email: String) -> Maybe<&2, Rel>:
63	  match differs:
64	    case True{}:
65	      Some{Rel{slot, email, "credentials-replaced"}}
66	    case False{}:
67	      None{}
68	
69	def opt_eq(+a: Maybe<&2, String>, +b: Maybe<&2, String>) -> Bool:
70	  match a b:
71	    case None{} None{}:
72	      True{}
73	    case Some{x} Some{y}:
74	      String.eq(x, y)
75	    case _ _:
76	      False{}
77	
78	def fp_differs(+entry: Maybe<&2, String>, +fp: String) -> Bool:
79	  Bool.not(opt_eq(entry, fp_opt(fp)))
80	
81	def gone(+email_now: String, +entry_email: String) -> Bool:
82	  String.is_empty(email_now) || Bool.not(String.eq(email_now, entry_email))
83	
84	def compare_fp(+root: String, +st: Json.Json, +slot: String, +email_now: String) -> Act.of(Maybe<&2, Rel>):
85	  do ActM<Maybe<&2, Rel>>:
86	    creds : String <- SIo.read_cred(root, slot, email_now)
87	    fp : String <- Act.lift(String, Fr.fingerprint(creds))
88	    return changed(fp_differs(St.entry_fp(st, slot), fp), slot, email_now)
89	
90	def check_slot(+root: String, +seq: Json.Json, +st: Json.Json, +slot: String) -> Act.of(Maybe<&2, Rel>):
91	  Act.cond(Maybe<&2, Rel>, gone(SIo.slot_email(seq, slot), St.entry_email(st, slot)),
92	    Act.pure(Maybe<&2, Rel>, replaced(slot, St.entry_email(st, slot))),
93	    compare_fp(root, st, slot, SIo.slot_email(seq, slot)))
94	
95	def rels(+root: String, +seq: Json.Json, +st: Json.Json, +slots: List<&2, String>) -> Act.of(List<&2, Rel>):
96	  match slots:
97	    case Nil{}:
98	      Act.pure(List<&2, Rel>, [])
99	    case Con{s, t}:
100	      do ActM<List<&2, Rel>>:
101	        m : Maybe<&2, Rel> <- check_slot(root, seq, st, s)
102	        rest : List<&2, Rel> <- rels(root, seq, st, t)
103	        return keep(m, rest)
104	
105	def drop_all(+rs: List<&2, Rel>, +st: Json.Json) -> Json.Json:
106	  match rs:
107	    case Nil{}:
108	      st
109	    case Con{Rel{s, e, r}, t}:
110	      drop_all(t, St.release(st, s))
111	
112	def events_of(+ts: String, +rs: List<&2, Rel>) -> List<&2, Json.Json>:
113	  match rs:
114	    case Nil{}:
115	      []
116	    case Con{Rel{s, e, r}, t}:
117	      Ev.unquarantined(ts, s, e, r) <> events_of(ts, t)
118	
119	def write_released(+root: String, +rs: List<&2, Rel>) -> Act.of(Unit):
120	  St.with_state_lock(Unit, root,
121	    do ActM<Unit>:
122	      st : Json.Json <- Act.lift(Json.Json, St.read_state(root))
123	      St.write_state(root, drop_all(rs, st)))
124	
125	def release_events(+root: String, +rs: List<&2, Rel>, +ts: String) -> Act.of(List<&2, Json.Json>):
126	  match rs:
127	    case Nil{}:
128	      Act.pure(List<&2, Json.Json>, [])
129	    case Con{r, t}:
130	      do ActM<List<&2, Json.Json>>:
131	        write_released(root, Con{r, t})
132	        return events_of(ts, Con{r, t})
133	
134	# Lift the quarantine of an account whose email or credential changed since
135	# it was quarantined (the user logged in again); answer the events.
136	def release_recovered(+root: String, +seq: Json.Json, +ts: String) -> Act.of(List<&2, Json.Json>):
137	  do ActM<List<&2, Json.Json>>:
138	    +st : Json.Json <- Act.lift(Json.Json, St.read_state(root))
139	    rs : List<&2, Rel> <- rels(root, seq, st, St.quarantined_slots(st))
140	    release_events(root, rs, ts)