1	import Base
2	import ../json.bend as Json
3	import ../b64.bend as B64
4	import ../fs.bend as Fs
5	import ../act.bend as Act
6	import ../clock.bend as Clock
7	import ../fs/write.bend as FsW
8	import ./base.bend as SBase
9	import ./seq.bend as SSeq
10	
11	# `do ActM<A>:` needs the monad defined in the file that uses it.
12	def ActM(-A: Type) -> Type:
13	  Act.of(A)
14	
15	def ActM.pure(-A: Type, x: A) -> Act.of(A):
16	  Act.pure(A, x)
17	
18	def ActM.bind(-A: Type, -B: Type, m: Act.of(A), f: A -> Act.of(B)) -> Act.of(B):
19	  Act.bind(A, B, m, f)
20	
21	# ---- IO: directories, log, files -------------------------------------------------------
22	
23	def now_iso() -> Act.of(String):
24	  do ActM<String>:
25	    t : U32 <- Act.lift(U32, Clock.now_s())
26	    return Clock.iso8601_utc(t)
27	
28	def swallow(r: Fs.Res(Unit)) -> Act.of(Unit):
29	  Act.pure(Unit, Unit{})
30	
31	def log_write(+root: String, +ts: String, +level: String, +msg: String) -> Act.of(Unit):
32	  IO.bind(Fs.Res(Unit), Fs.Res(Unit), FsW.append(SBase.log_path(root), SBase.log_line(ts, level, msg)), r => IO.pure(Fs.Res(Unit), Done{Unit{}}))
33	
34	# One line in claude-swap.log, in the reference's format. A log that cannot be
35	# written never fails the operation.
36	def log(+root: String, +level: String, +msg: String) -> Act.of(Unit):
37	  do ActM<Unit>:
38	    ts : String <- now_iso()
39	    log_write(root, ts, level, msg)
40	
41	def secure_dir(+path: String) -> Act.of(Unit):
42	  do ActM<Unit>:
43	    FsW.mkdir_p(path)
44	    FsW.chmod("700", path)
45	
46	# The backup root, credentials/ and configs/, all 0700.
47	def setup_dirs(+root: String) -> Act.of(Unit):
48	  do ActM<Unit>:
49	    secure_dir(root)
50	    secure_dir(SBase.creds_dir(root))
51	    secure_dir(SBase.configs_dir(root))
52	
53	def write_secret(+path: String, +text: String) -> Act.of(Unit):
54	  FsW.write_atomic(path, text, "600")
55	
56	def write_seq(+root: String, +j: Json.Json) -> Act.of(Unit):
57	  write_secret(SBase.seq_path(root), Json.emit_pretty(j))
58	
59	def parse_seq(+path: String, r: Result<&2, &2, String, Json.Json>) -> Act.of(Maybe<&2, Json.Json>):
60	  match r:
61	    case Fail{e}:
62	      Act.fail(Maybe<&2, Json.Json>, 1, path ++ " exists but could not be parsed (" ++ e ++ "). Repair or move it, then retry — refusing to overwrite it unread.")
63	    case Done{j}:
64	      Act.pure(Maybe<&2, Json.Json>, Some{j})
65	
66	def read_seq2(+ex: Bool, +path: String) -> Act.of(Maybe<&2, Json.Json>):
67	  match ex:
68	    case False{}:
69	      Act.pure(Maybe<&2, Json.Json>, None{})
70	    case True{}:
71	      do ActM<Maybe<&2, Json.Json>>:
72	        text : String <- Fs.read_file(path)
73	        parse_seq(path, Json.parse(text))
74	
75	# sequence.json, or None when there is none yet. A torn file is an error and
76	# is never replaced.
77	def read_seq(+root: String) -> Act.of(Maybe<&2, Json.Json>):
78	  do ActM<Maybe<&2, Json.Json>>:
79	    ex : Bool <- Act.lift(Bool, Fs.exists(SBase.seq_path(root)))
80	    read_seq2(ex, SBase.seq_path(root))
81	
82	def ensure_seq2(+m: Maybe<&2, Json.Json>, +root: String, +ts: String) -> Act.of(Json.Json):
83	  match m:
84	    case Some{j}:
85	      Act.pure(Json.Json, j)
86	    case None{}:
87	      do ActM<Json.Json>:
88	        write_seq(root, SSeq.seq_fresh(ts))
89	        return SSeq.seq_fresh(ts)
90	
91	# sequence.json, written fresh first when it does not exist.
92	def ensure_seq(+root: String, +ts: String) -> Act.of(Json.Json):
93	  do ActM<Json.Json>:
94	    m : Maybe<&2, Json.Json> <- read_seq(root)
95	    ensure_seq2(m, root, ts)
96	
97	def decoded(+m: Maybe<&2, String>) -> String:
98	  SSeq.str_or(m, "")
99	
100	def read_cred2(+ex: Bool, +path: String) -> Act.of(String):
101	  match ex:
102	    case False{}:
103	      Act.pure(String, "")
104	    case True{}:
105	      do ActM<String>:
106	        text : String <- Fs.read_file(path)
107	        return decoded(B64.decode(String.trim(text)))
108	
109	# A slot's stored credential: the decoded text, "" when absent or undecodable.
110	def read_cred(+root: String, +slot: String, +email: String) -> Act.of(String):
111	  do ActM<String>:
112	    ex : Bool <- Act.lift(Bool, Fs.exists(SBase.enc_path(root, slot, email)))
113	    read_cred2(ex, SBase.enc_path(root, slot, email))
114	
115	def keep_prev(+keep: Bool, +root: String, +slot: String, +email: String, +cur: String) -> Act.of(Unit):
116	  Act.cond(Unit, keep, write_secret(SBase.prev_path(root, slot, email), B64.encode(cur)), Act.pure(Unit, Unit{}))
117	
118	# Store a slot's credential (0600). The generation it replaces is kept as
119	# `.enc.prev` when it was readable and different.
120	def write_cred(+root: String, +slot: String, +email: String, +creds: String) -> Act.of(Unit):
121	  do ActM<Unit>:
122	    +cur : String <- read_cred(root, slot, email)
123	    keep_prev(SBase.nonempty(cur) && SBase.not_(String.eq(cur, creds)), root, slot, email, cur)
124	    write_secret(SBase.enc_path(root, slot, email), B64.encode(creds))
125	
126	def write_config(+root: String, +slot: String, +email: String, +text: String) -> Act.of(Unit):
127	  write_secret(SBase.config_path(root, slot, email), text)
128	
129	def read_config(+root: String, +slot: String, +email: String) -> Act.of(String):
130	  Fs.read_file(SBase.config_path(root, slot, email))
131	
132	# ---- archiving: a slot's files are moved aside, never deleted ----------------------
133	
134	def mv_keep2(+ex: Bool, +src: String, +dst: String) -> Act.of(Unit):
135	  match ex:
136	    case False{}:
137	      Act.pure(Unit, Unit{})
138	    case True{}:
139	      do ActM<Unit>:
140	        FsW.rename(src, dst)
141	        FsW.chmod("600", dst)
142	
143	def mv_keep(+src: String, +dst: String) -> Act.of(Unit):
144	  do ActM<Unit>:
145	    ex : Bool <- Act.lift(Bool, Fs.exists(src))
146	    mv_keep2(ex, src, dst)
147	
148	# Move the slot's .enc (and .prev, legacy copy, config) under .removed/ with a
149	# UTC time stamp. This is where `remove` and every slot displacement send a
150	# credential: the reference deletes them, which lost the only full login once.
151	def archive_dirs(+root: String) -> Act.of(Unit):
152	  do ActM<Unit>:
153	    secure_dir(SBase.removed_dir(root))
154	    secure_dir(SBase.removed_configs_dir(root))
155	
156	def archive_mv(+root: String, +slot: String, +email: String, +ts: String) -> Act.of(Unit):
157	  do ActM<Unit>:
158	    mv_keep(SBase.enc_path(root, slot, email), SBase.removed_enc_path(root, ts, slot, email))
159	    mv_keep(SBase.prev_path(root, slot, email), SBase.removed_enc_path(root, ts, slot, email) ++ ".prev")
160	    mv_keep(SBase.enc_path(root, "None", email), SBase.removed_enc_path(root, ts, "None", email))
161	    mv_keep(SBase.config_path(root, slot, email), SBase.removed_config_path(root, ts, slot, email))
162	
163	def archive_slot(+root: String, +slot: String, +email: String, +ts: String) -> Act.of(Unit):
164	  do ActM<Unit>:
165	    archive_dirs(root)
166	    archive_mv(root, slot, email, ts)
167	    log(root, "INFO", "Archived slot " ++ slot ++ " (" ++ email ++ ") to " ++ SBase.removed_enc_path(root, ts, slot, email) ++ "; credentials are moved aside, never deleted")
168	
169	def slot_email2(+m: Maybe<&2, Json.Json>) -> String:
170	  match m:
171	    case None{}:
172	      ""
173	    case Some{r}:
174	      SSeq.field_str(r, "email")
175	
176	def slot_email(+seq: Json.Json, +num: String) -> String:
177	  slot_email2(SSeq.slot_record(seq, num))
178	
179	# Archive a slot's files and forget its record; sequence.json is rewritten.
180	def drop_slot(+root: String, +seq: Json.Json, +num: String, +ts: String) -> Act.of(Json.Json):
181	  do ActM<Json.Json>:
182	    archive_slot(root, num, slot_email(seq, num), ts)
183	    +next : Json.Json = SSeq.stamp(SSeq.drop_account(seq, num), ts)
184	    write_seq(root, next)
185	    return next
186	
187	def drop_opt(+root: String, +seq: Json.Json, +m: Maybe<&2, String>, +ts: String) -> Act.of(Json.Json):
188	  match m:
189	    case None{}:
190	      Act.pure(Json.Json, seq)
191	    case Some{n}:
192	      drop_slot(root, seq, n, ts)
193	
194	# Archive what a displaced and a migrated slot held, in that order.
195	def drop_pair(+root: String, +seq: Json.Json, +displace: Maybe<&2, String>, +migrate: Maybe<&2, String>, +ts: String) -> Act.of(Json.Json):
196	  do ActM<Json.Json>:
197	    s1 : Json.Json <- drop_opt(root, seq, displace, ts)
198	    drop_opt(root, s1, migrate, ts)