store/io.bend

cswap-bend-cli@0.1.0.0 · 198 lines · 33 definitions

1import Base
2import cswap-bend-cli@0.1.0.0/json.bend as Json
3import cswap-bend-cli@0.1.0.0/b64.bend as B64
4import cswap-bend-cli@0.1.0.0/fs.bend as Fs
5import cswap-bend-cli@0.1.0.0/act.bend as Act
6import cswap-bend-cli@0.1.0.0/clock.bend as Clock
7import cswap-bend-cli@0.1.0.0/fs/write.bend as FsW
8import cswap-bend-cli@0.1.0.0/store/base.bend as SBase
9import cswap-bend-cli@0.1.0.0/store/seq.bend as SSeq
10
11# `do ActM<A>:` needs the monad defined in the file that uses it.
12def ActM(-A: Type) -> Type:
13  Act.of(A)
14
15def ActM.pure(-A: Type, x: A) -> Act.of(A):
16  Act.pure(A, x)
17
18def 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
23def 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
28def swallow(r: Fs.Res(Unit)) -> Act.of(Unit):
29  Act.pure(Unit, Unit{})
30
31def 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.
36def 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
41def 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.
47def 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
53def write_secret(+path: String, +text: String) -> Act.of(Unit):
54  FsW.write_atomic(path, text, "600")
55
56def write_seq(+root: String, +j: Json.Json) -> Act.of(Unit):
57  write_secret(SBase.seq_path(root), Json.emit_pretty(j))
58
59def 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
66def 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.
77def 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
82def 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.
92def 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
97def decoded(+m: Maybe<&2, String>) -> String:
98  SSeq.str_or(m, "")
99
100def 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.
110def 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
115def 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.
120def 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
126def write_config(+root: String, +slot: String, +email: String, +text: String) -> Act.of(Unit):
127  write_secret(SBase.config_path(root, slot, email), text)
128
129def 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
134def 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
143def 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.
151def 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
156def 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
163def 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
169def 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
176def 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.
180def 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
187def 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.
195def 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)