1	# sha/nar: the SRI `nix hash path --sri` would give for a directory, computed
2	# without nix. A NAR is the tree as length-prefixed strings; its sha256, in
3	# SRI form, is what fetchgit records as narHash.
4	#
5	# The tree is read in one listing, then every regular file's text, and the
6	# NAR is built from what was read by a pure, fuelled state machine: each step
7	# places one path or closes one directory, the way lock/resolve and pkg/walk
8	# carry on, since two Bend defs may not call each other. What the NAR holds
9	# of a path is what nix's dumper takes: the owner's exec bit of the mode,
10	# every name and link target as it is, and a file's bytes. The reading is
11	# sha/dump's, since it runs `find` through foreign code a law may not import.
12	import Base
13	import ../pkg/pkg.bend as K
14	import ../share/sha.bend as Sha
15	
16	# A directory child is a `K.Item`: its name in `at` and the NAR serial of its
17	# node in `sum`. That is a package file's shape, a name and the text that
18	# stands for it, so the walk sorts children with the same `K.file.sort` a
19	# package sorts its files with, and what is proved of that sort is proved of
20	# the NAR.
21	
22	# one byte as a character. NAR is a byte stream held in a Bend string.
23	def byte(+code: U32) -> Char:
24	  Chr{(code .&. 255 : U32)}
25	
26	def nat.byte(+value: Nat) -> Char:
27	  byte(U32.from_nat(Nat.mod(value, 256n)))
28	
29	def le64.go(width: Nat, +value: Nat) -> String:
30	  match width:
31	    case 0n:
32	      ""
33	    case 1n+f:
34	      SCon{nat.byte(value), le64.go(f, Nat.div(value, 256n))}
35	
36	# a length as NAR writes it: eight bytes, little-endian
37	def le64(+value: Nat) -> String:
38	  le64.go(8n, value)
39	
40	# that many NUL bytes, the padding after a string
41	def zeros(count: Nat) -> String:
42	  match count:
43	    case 0n:
44	      ""
45	    case 1n+p:
46	      SCon{Chr{0}, zeros(p)}
47	
48	def pad.of(+len: Nat) -> Nat:
49	  Nat.mod(Nat.sub(8n, Nat.mod(len, 8n)), 8n)
50	
51	# one NAR string: its length, its bytes, then zeros up to a multiple of eight
52	def str(+text: String) -> String:
53	  +n = String.length(text)
54	  le64(n) ++ text ++ zeros(pad.of(n))
55	
56	def exec.fields(ex: Bool) -> String:
57	  match ex:
58	    case False{}:
59	      ""
60	    case True{}:
61	      str("executable") ++ str("")
62	
63	# a regular file's node, marked executable when it is
64	def regular(ex: Bool, +contents: String) -> String:
65	  str("(") ++ str("type") ++ str("regular") ++ exec.fields(ex)
66	    ++ str("contents") ++ str(Sha.utf8(contents)) ++ str(")")
67	
68	# a symlink's node
69	def symlink(+target: String) -> String:
70	  str("(") ++ str("type") ++ str("symlink") ++ str("target")
71	    ++ str(Sha.utf8(target)) ++ str(")")
72	
73	# one directory entry: its name and its node
74	def entry(+ent: K.Item) -> String:
75	  K.Item{name, node} = ent
76	  str("entry") ++ str("(") ++ str("name") ++ str(Sha.utf8(name))
77	    ++ str("node") ++ node ++ str(")")
78	
79	# a directory's entries, in the order given
80	def entries(es: List<&2, K.Item>) -> String:
81	  match es:
82	    case []:
83	      ""
84	    case h <> t:
85	      entry(h) ++ entries(t)
86	
87	# a directory's node, its entries in the order given
88	def directory(es: List<&2, K.Item>) -> String:
89	  str("(") ++ str("type") ++ str("directory") ++ entries(es) ++ str(")")
90	
91	# a directory's node as NAR writes it: its entries sorted by name, whatever
92	# order they were listed in. `String.is_le` is codepoint order, which is nix's
93	# byte order for the UTF-8 of valid names. Every directory the walk serializes
94	# goes through here, so the order `find` printed its names in never reaches
95	# the NAR.
96	def dir(es: List<&2, K.Item>) -> String:
97	  directory(K.file.sort(es))
98	
99	# a whole NAR: the magic, then the root node
100	def archive(+node: String) -> String:
101	  str("nix-archive-1") ++ node
102	
103	def b64.digit.plus(plus: Bool) -> Char:
104	  match plus:
105	    case True{}:
106	      '+'
107	    case False{}:
108	      '/'
109	
110	def b64.digit.lt62(small: Bool, +index: U32) -> Char:
111	  match small:
112	    case True{}:
113	      Chr{U32.add(48, U32.sub(index, 52))}
114	    case False{}:
115	      b64.digit.plus(U32.is_eq(index, 62))
116	
117	def b64.digit.lt52(small: Bool, +index: U32) -> Char:
118	  match small:
119	    case True{}:
120	      Chr{U32.add(97, U32.sub(index, 26))}
121	    case False{}:
122	      b64.digit.lt62(U32.is_lt(index, 62), index)
123	
124	def b64.digit.lt26(small: Bool, +index: U32) -> Char:
125	  match small:
126	    case True{}:
127	      Chr{U32.add(65, index)}
128	    case False{}:
129	      b64.digit.lt52(U32.is_lt(index, 52), index)
130	
131	def b64.digit(+index: U32) -> Char:
132	  b64.digit.lt26(U32.is_lt(index, 26), index)
133	
134	def b64.triple(+first: U32, +second: U32, +third: U32) -> String:
135	  +n = (U32.shln(first, 16n) .|. U32.shln(second, 8n) .|. third : U32)
136	  SCon{b64.digit(U32.shrn(n, 18n)),
137	    SCon{b64.digit((U32.shrn(n, 12n) .&. 63 : U32)),
138	      SCon{b64.digit((U32.shrn(n, 6n) .&. 63 : U32)),
139	        SCon{b64.digit((n .&. 63 : U32)), SNil{}}}}}
140	
141	def b64.one(+first: U32) -> String:
142	  SCon{b64.digit(U32.shrn(first, 2n)),
143	    SCon{b64.digit(U32.shln((first .&. 3 : U32), 4n)),
144	      SCon{'=', SCon{'=', SNil{}}}}}
145	
146	def b64.two(+first: U32, +second: U32) -> String:
147	  +n = (U32.shln(first, 8n) .|. second : U32)
148	  SCon{b64.digit(U32.shrn(n, 10n)),
149	    SCon{b64.digit((U32.shrn(n, 4n) .&. 63 : U32)),
150	      SCon{b64.digit(U32.shln((n .&. 15 : U32), 2n)),
151	        SCon{'=', SNil{}}}}}
152	
153	# standard base64, padded with `=`
154	def b64(text: String) -> String:
155	  match text:
156	    case SNil{}:
157	      ""
158	    case SCon{a, SNil{}}:
159	      b64.one(Char.to_u32(a))
160	    case SCon{a, SCon{b, SNil{}}}:
161	      b64.two(Char.to_u32(a), Char.to_u32(b))
162	    case SCon{a, SCon{b, SCon{c, t}}}:
163	      b64.triple(Char.to_u32(a), Char.to_u32(b), Char.to_u32(c)) ++ b64(t)
164	
165	def hex.val.upper(is_upper: Bool, +code: U32) -> U32:
166	  match is_upper:
167	    case True{}:
168	      U32.sub(code, 55)
169	    case False{}:
170	      0
171	
172	def hex.val.lower(is_lower: Bool, +code: U32) -> U32:
173	  match is_lower:
174	    case True{}:
175	      U32.sub(code, 87)
176	    case False{}:
177	      hex.val.upper(Bool.and(U32.is_ge(code, 65), U32.is_le(code, 70)), code)
178	
179	def hex.val.digit(is_digit: Bool, +code: U32) -> U32:
180	  match is_digit:
181	    case True{}:
182	      U32.sub(code, 48)
183	    case False{}:
184	      hex.val.lower(Bool.and(U32.is_ge(code, 97), U32.is_le(code, 102)), code)
185	
186	def hex.val(+ch: Char) -> U32:
187	  +u = Char.to_u32(ch)
188	  hex.val.digit(Bool.and(U32.is_ge(u, 48), U32.is_le(u, 57)), u)
189	
190	def hex.bytes(text: String) -> String:
191	  match text:
192	    case SNil{}:
193	      ""
194	    case SCon{_a, SNil{}}:
195	      ""
196	    case SCon{a, SCon{b, t}}:
197	      SCon{byte((U32.shln(hex.val(a), 4n) + hex.val(b) : U32)), hex.bytes(t)}
198	
199	def sri.hex(+hex: String) -> String:
200	  "sha256-" ++ b64(hex.bytes(hex))
201	
202	# the SRI of some bytes: `sha256-` and the base64 of their digest
203	def sri(+bytes: String) -> String:
204	  sri.hex(Sha.raw(bytes))
205	
206	# the node of an empty directory
207	def empty() -> String:
208	  dir([])
209	
210	
211	# ---------------------------------------------------------------------------
212	# the listing
213	#
214	# The tree is listed once, by one `find` from its top, and every field of
215	# every path is ended by a NUL, the one byte no name or target can hold. So a
216	# name is read as it is, a space at either end and a newline inside it
217	# included, and no field is ever trimmed. The paths inside the tree are never
218	# handed to a program as arguments, since the process effect separates
219	# arguments by newlines; only the top is, and a file's text is read by its
220	# path through the file effect, which takes any name.
221	
222	# the NUL that ends every field of the listing
223	def nul() -> Char:
224	  Chr{0}
225	
226	# a char put in front of the first field, which a text that does not end with
227	# a NUL leaves open
228	def push(+ch: Char, fs: List<&2, String>) -> List<&2, String>:
229	  match fs:
230	    case []:
231	      [SCon{ch, SNil{}}]
232	    case h <> t:
233	      SCon{ch, h} <> t
234	
235	# one char of the listing read: a NUL ends a field, any other char is the
236	# next of the field it is in
237	def cut.at(ends: Bool, +ch: Char, fs: List<&2, String>) -> List<&2, String>:
238	  match ends:
239	    case True{}:
240	      "" <> fs
241	    case False{}:
242	      push(ch, fs)
243	
244	# the fields of a listing, each ended by a NUL, exactly as they were printed
245	def cut(text: String) -> List<&2, String>:
246	  match text:
247	    case SNil{}:
248	      []
249	    case SCon{+c, t}:
250	      cut.at(Char.is_eq(c, nul()), c, cut(t))
251	
252	# whether a text holds no NUL, as no name and no link target can
253	def clean(text: String) -> Bool:
254	  match text:
255	    case SNil{}:
256	      True{}
257	    case SCon{c, t}:
258	      +rest = clean(t)
259	      Bool.and(Bool.not(Char.is_eq(c, nul())), rest)
260	
261	# fields as the listing prints them, each ended by a NUL
262	def joined(fs: List<&2, String>) -> String:
263	  match fs:
264	    case []:
265	      ""
266	    case h <> t:
267	      String.append(h, SCon{nul(), joined(t)})
268	
269	# whether every field holds no NUL
270	def clean.all(fs: List<&2, String>) -> Bool:
271	  match fs:
272	    case []:
273	      True{}
274	    case h <> t:
275	      +rest = clean.all(t)
276	      Bool.and(clean(h), rest)
277	
278	# whether a file's owner may execute it, from the mode `find` prints as
279	# `%M`, `-rwxr-xr-x`: the fourth character is `x`, or `s` when the setuid
280	# bit is set as well. This is the mode bit nix's NAR dumper reads
281	# (`S_IXUSR`), not an access check, so a file the owner may not execute is
282	# not executable whoever weighs it.
283	def owner.exec(mode: String) -> Bool:
284	  match mode:
285	    case SCon{_t, SCon{_r, SCon{_w, SCon{+x, _rest}}}}:
286	      Bool.or(Char.is_eq(x, 'x'), Char.is_eq(x, 's'))
287	    case _:
288	      False{}
289	
290	# one path of the listing: its type as `%y` gives it (`d`, `f`, `l`), its
291	# mode (`%M`), its name (`%f`), its path from the top (`%P`) and a symlink's
292	# target (`%l`)
293	type Row is Data:
294	  Row{kind: String, mode: String, name: String, at: String, target: String}
295	
296	# the listing's fields, five to a path. A path the listing cut short is not
297	# read.
298	def rows(fs: List<&2, String>) -> List<&2, Row>:
299	  match fs:
300	    case Con{y, Con{m, Con{f, Con{p, Con{l, rest}}}}}:
301	      Row{y, m, f, p, l} <> rows(rest)
302	    case _:
303	      []
304	
305	# what `find` is asked to print of every path under `top`, the top first,
306	# each field ended by a NUL. `find` lists a directory before what is in it
307	# and all of it before the next entry, which is the order `build` reads.
308	def listing.argv(+top: String) -> List<&2, String>:
309	  ["find", top, "-printf", "%y\\0%M\\0%f\\0%P\\0%l\\0"]
310	
311	# ---------------------------------------------------------------------------
312	# the tree
313	
314	# one path of the tree with what the NAR holds of it: a file's text, or a
315	# symlink's target, as `body`
316	type Ent is Data:
317	  Ent{kind: String, exec: Bool, name: String, at: String, body: String}
318	
319	# a directory still open: its path from the top, its name, and the entries
320	# found in it so far
321	type Frame is Data:
322	  Frame{at: String, name: String, kids: List<&2, K.Item>}
323	
324	# where the build stands: the paths still to place, the directory they are
325	# being placed in, and the directories around it
326	type State is Data:
327	  State{es: List<&2, Ent>, top: Frame, up: List<&2, Frame>}
328	
329	# a step of the build: another state, or the finished node of the top
330	type Move is Data:
331	  Next{st: State}
332	  Built{node: String}
333	
334	def leaf.of(link: Bool, ex: Bool, +body: String) -> String:
335	  match link:
336	    case True{}:
337	      symlink(body)
338	    case False{}:
339	      regular(ex, body)
340	
341	# a file's or a symlink's node
342	def leaf(entry: Ent) -> String:
343	  Ent{+kind, ex, _name, _at, body} = entry
344	  leaf.of(String.eq(kind, "l"), ex, body)
345	
346	# the path of an entry named `name` inside the directory at `at`
347	def under(+at: String, +name: String) -> String:
348	  Bool.pick(String, String.is_empty(at), name, at ++ "/" ++ name)
349	
350	# the directory on top finished: its node is an entry of the one around it,
351	# or the whole tree when there is none
352	def close(top: Frame, up: List<&2, Frame>, es: List<&2, Ent>) -> Move:
353	  Frame{_at, +name, kids} = top
354	  match up:
355	    case []:
356	      Built{dir(kids)}
357	    case Frame{pat, pname, pkids} <> rest:
358	      Next{State{es, Frame{pat, pname, K.Item{name, dir(kids)} <> pkids}, rest}}
359	
360	# an entry's type, name and path, and an open directory's path
361	def ent.kind(entry: Ent) -> String:
362	  Ent{kind, _ex, _name, _at, _body} = entry
363	  kind
364	
365	# an entry's name
366	def ent.name(entry: Ent) -> String:
367	  Ent{_kind, _ex, name, _at, _body} = entry
368	  name
369	
370	# an entry's path from the top
371	def ent.at(entry: Ent) -> String:
372	  Ent{_kind, _ex, _name, at, _body} = entry
373	  at
374	
375	# an open directory's path from the top
376	def frame.at(frame: Frame) -> String:
377	  Frame{at, _name, _kids} = frame
378	  at
379	
380	# a path inside the directory on top: a directory is opened, anything else
381	# is an entry of it, with its leaf's node
382	def place(
383	  is_dir: Bool,
384	  +name: String,
385	  +at: String,
386	  +node: String,
387	  more: List<&2, Ent>,
388	  top: Frame,
389	  up: List<&2, Frame>
390	) -> Move:
391	  match is_dir:
392	    case True{}:
393	      Next{State{more, Frame{at, name, []}, top <> up}}
394	    case False{}:
395	      Frame{a, n, ks} = top
396	      Next{State{more, Frame{a, n, K.Item{name, node} <> ks}, up}}
397	
398	# the next path: placed when it is inside the directory on top, which closes
399	# otherwise
400	def step.ent(
401	  inside: Bool,
402	  +entry: Ent,
403	  more: List<&2, Ent>,
404	  top: Frame,
405	  up: List<&2, Frame>
406	) -> Move:
407	  match inside:
408	    case True{}:
409	      place(String.eq(ent.kind(entry), "d"), ent.name(entry), ent.at(entry), leaf(entry), more, top, up)
410	    case False{}:
411	      close(top, up, entry <> more)
412	
413	# one step of the build
414	def step(st: State) -> Move:
415	  State{es, +top, up} = st
416	  match es:
417	    case []:
418	      close(top, up, [])
419	    case +e <> t:
420	      step.ent(String.eq(ent.at(e), under(frame.at(top), ent.name(e))), e, t, top, up)
421	
422	# the build, under fuel
423	def build.go(fuel: Nat, mv: Move) -> Maybe<&2, String>:
424	  match fuel:
425	    case 0n:
426	      None{}
427	    case 1n+f:
428	      match mv:
429	        case Next{st}:
430	          build.go(f, step(st))
431	        case Built{node}:
432	          Some{node}
433	
434	# the node of a directory, from its paths in the order `find` lists them. Each
435	# step places a path or closes a directory, and each directory is closed
436	# once, so twice the paths and two more is fuel enough.
437	def build(+es: List<&2, Ent>) -> Maybe<&2, String>:
438	  +n = List.length(&2, Ent, es)
439	  build.go(Nat.add(Nat.add(n, n), 2n), Next{State{es, Frame{"", "", []}, []}})
440	
441	# the node of the whole tree, from its listing with the top first: a
442	# directory is built, a file or a symlink is a leaf
443	def tree.top(is_dir: Bool, top: Ent, more: List<&2, Ent>) -> Maybe<&2, String>:
444	  match is_dir:
445	    case True{}:
446	      build(more)
447	    case False{}:
448	      Some{leaf(top)}
449	
450	# the node of the whole tree, or none for an empty listing
451	def tree(es: List<&2, Ent>) -> Maybe<&2, String>:
452	  match es:
453	    case []:
454	      None{}
455	    case Ent{+kind, ex, name, at, body} <> t:
456	      tree.top(String.eq(kind, "d"), Ent{kind, ex, name, at, body}, t)