Persistent store with Git semantics: lazy reads, delayed writes, content-addressing
irmin: navbar avatar + /admin page + hosting plan (TODO.md)
- Layout.Signed_in now carries email + name + avatar_url. Navbar
renders a 32px circular avatar (falls back to a grey initial pill
when avatar_url = ""), the display name with email as title, an
Admin link, and a Sign out button.
- /admin page shows Identity (name, email, allowed/not-allowed tag),
Upload allowlist (from refs/meta/config:admin.toml), and Branches.
Non-allowlisted signed-in users get a 403 with a Sign-in CTA.
- irmin/TODO.md captures the full hosting plan: 3-segment refs
(owner/project/branch), org-level ACL with github(...) references,
auto-provisioned user namespaces, content-addressable access tiers
(/h/:hash, /cap/:hash, /g/:id), phased rollout with Linus/Miod review.
+1069
-169
+270
TODO.md
+270
TODO.md
···
1
+
# Irmin hosting plan
2
+
3
+
Goal: turn `irmin serve` into a small GitHub-shaped file host where
4
+
versioned files are gated by an ACL committed inside the Irmin repo
5
+
itself. Every write is a commit; the commit log is the audit trail.
6
+
7
+
## Model
8
+
9
+
- **Refs are 3-segment**: `<owner>/<project>/<branch>`. Each segment is
10
+
`[a-z0-9][a-z0-9._-]{0,62}`. Stored in git as
11
+
`refs/heads/<owner>/<project>/<branch>`. Ref names that don't match
12
+
the 3-segment form cannot be created via the HTTP API.
13
+
- **Admin config is itself 3-segment**: the global admin file lives at
14
+
`admin/meta/config:main:admin.toml`. Each org keeps its own overrides
15
+
at `<org>/meta/config:main:org.toml`.
16
+
- **Three user roles per org**: `readers`, `writers`, `admins`. The
17
+
user-facing actions map 1-to-1 (fetch, commit, edit-membership).
18
+
- **User namespaces are derived, never stored**: if the signed-in
19
+
user's GitHub login equals an org name, that user is an implicit
20
+
admin of that org. No commit, no race, no bootstrap.
21
+
- **GitHub references** in `admin.toml` allow membership to be
22
+
delegated to a GH repo, org, or team:
23
+
24
+
```toml
25
+
[[org]]
26
+
name = "blacksun"
27
+
writers = [
28
+
"alice@example.com",
29
+
"github(samoht/irmin:write)",
30
+
"github(blacksun/team:core)",
31
+
]
32
+
```
33
+
34
+
The `:role` suffix is a minimum: `github(x/y:write)` matches anyone
35
+
with write-or-higher on `x/y`.
36
+
37
+
- **Invariant**: a GH reference grants authority only to the principals
38
+
named in `admin.toml`. Nothing dynamic can introduce a new org or
39
+
rename an existing one.
40
+
41
+
## Content-addressable access
42
+
43
+
Three coherent surfaces:
44
+
45
+
1. `GET /h/:hash` — auth-gated (allowlist members). Fetch any object in
46
+
the heap by hash. This is the "drop-a-file, share-the-hash"
47
+
pastebin flow, bounded by the trust boundary.
48
+
2. `GET /cap/:hash` — public, no auth. Serves only hashes listed in the
49
+
signed `admin/published/main:manifest.toml`. For release artifacts,
50
+
CI outputs, CDN-cacheable public blobs. `irmin publish <hash>` and
51
+
`irmin unpublish <hash>` write the signed entries.
52
+
3. `GET /g/:id` — gists. Short (16-hex) capability URLs with
53
+
per-artifact visibility (public / internal / secret / private).
54
+
Backed by a branch at `<owner>/_gists/<id>`; metadata in
55
+
`<owner>/_gists/<id>:main:meta.toml`. The `_gists` project name is
56
+
reserved (parser rejects user-created projects starting with `_`).
57
+
58
+
When per-org ACLs eventually tighten beyond "everyone on the allowlist
59
+
reads everything", `/h/:hash` gains a reachability check: "is this
60
+
hash reachable from any branch the caller can read?" Backed by EWAH
61
+
reachability bitmaps (see `ocaml-ewah` prerequisite below).
62
+
63
+
## Routes
64
+
65
+
Open (no auth):
66
+
67
+
- `GET /auth/github`, `GET /auth/github/callback`, `POST /auth/signout`
68
+
- `GET /tw.css`
69
+
- `GET /cap/:hash`
70
+
- `GET /g/:id` (visibility checked per-gist)
71
+
72
+
Auth-gated (sign in + allowlist):
73
+
74
+
- `GET /` — owner listing (orgs caller can read)
75
+
- `GET /:owner/` — project listing
76
+
- `GET /:owner/:project/` — branch listing
77
+
- `GET /:owner/:project/:branch/` + `/**` — tree / file
78
+
- `POST /:owner/:project/:branch/upload` — multipart upload
79
+
- `GET /h/:hash` — content-addressable fetch
80
+
- `GET /admin` — shows your identity, org memberships, allowlist
81
+
82
+
Explicitly removed:
83
+
84
+
- `GET /blocks/:hash` — unscoped, attack surface. Replaced by `/h`.
85
+
86
+
## Failure modes
87
+
88
+
- **admin.toml parse error on startup**: server refuses to bind,
89
+
prints error to stderr, operator fixes via CLI (`irmin admin reset
90
+
--admin <email>`). Existing sessions are not served.
91
+
- **admin.toml parse error on reload**: previous good config stays
92
+
active (via `Atomic.t` swap). Loud log entry. Server keeps running.
93
+
- **GitHub API unreachable**: cached values serve; cache miss fails
94
+
closed (treat as no match). Literal emails in the same list
95
+
continue to resolve without GH.
96
+
- **Cache revocation latency**: default TTL 60 seconds. Webhook at
97
+
`/auth/github/webhook` invalidates immediately on
98
+
`collaborator_added/removed` and `membership_added/removed`. Webhook
99
+
is **required** for Phase 3 (not optional).
100
+
- **Gist short-ID collision**: extend ID by one hex char and retry.
101
+
Deterministic.
102
+
- **Secret gists**: URL-is-capability. 16 hex chars (64 bits) minimum.
103
+
104
+
## Phases
105
+
106
+
### Phase 0 — Lockdown (no design changes, fixes the current leak)
107
+
108
+
- Require `IRMIN_AUTH_*` env vars; refuse to bind otherwise. Local-dev
109
+
escape hatch: `IRMIN_AUTH_DISABLED=1` with a loud warning.
110
+
- Wrap every non-`/auth/*`, non-`/tw.css` route in `require_user`.
111
+
Anon → 302 `/auth/github`. Signed-in-not-allowed → 404 (not 403).
112
+
- Remove `/blocks/:hash`.
113
+
- Hide `refs/meta/*` from the branch listing.
114
+
115
+
~50 lines. Independent of every other phase. Ships first.
116
+
117
+
### Phase 1 — 3-segment refs + `/h/:hash`
118
+
119
+
- Inline ref-name parser (~30 lines regex + rejection). No new module.
120
+
- Route rewrite: `/:owner/:project/:branch/**`, with listing pages at
121
+
`/`, `/:owner/`, `/:owner/:project/`.
122
+
- Upload endpoint enforces 3-segment form; creating any other ref
123
+
shape via HTTP is impossible.
124
+
- `admin/meta/config` becomes a regular 3-segment ref.
125
+
- Auth-gated `GET /h/:hash` serves any heap object to allowlist
126
+
members. On-demand traversal for now; EWAH bitmaps later
127
+
(prerequisite package).
128
+
129
+
~200 lines.
130
+
131
+
### Phase 2 — Org-level ACL + admin-as-org
132
+
133
+
- `tomlt`-based parser for `admin.toml` and `<org>/meta/config:main:
134
+
org.toml`.
135
+
- Resolver `can : action -> owner -> user -> bool`.
136
+
- Derived rule: `user.gh_login == org.name ⇒ implicit admin`.
137
+
- Config reload on every request via `Atomic.t` swap; parse failure
138
+
keeps the previous good config alive.
139
+
- Bootstrap CLI: `irmin admin init --admin <email>` writes the first
140
+
signed `admin/meta/config:main:admin.toml`.
141
+
142
+
~250 lines.
143
+
144
+
### Phase 3 — GitHub reference inheritance
145
+
146
+
- `IRMIN_GITHUB_APP_ID`, `_PRIVATE_KEY_PATH`, `_INSTALLATION_ID` env
147
+
vars. GitHub App only; no PAT support.
148
+
- Reference resolver for `github(<owner>/<repo>:<role>)`,
149
+
`github(<org>)`, `github(<org>/team:<slug>)`.
150
+
- LRU cache, 60-second TTL, bounded 10k entries. Fail-closed on miss
151
+
when GH unreachable.
152
+
- Required webhook handler for `collaborator_added/removed` and
153
+
`membership_added/removed` → cache invalidation.
154
+
155
+
~250 lines.
156
+
157
+
### Phase 4 — Content-addressable reachability (scaled)
158
+
159
+
Prerequisite: **ocaml-ewah** package (new monorepo lib).
160
+
161
+
- Port Lemire's EWAH bitmap compression (~300 lines + tests).
162
+
- Irmin stores one bitmap per ref head; invalidated on commit.
163
+
- Reachability check: union bitmaps for branches caller can read,
164
+
test bit at hash's index. O(1) after index lookup.
165
+
- Replaces the on-demand traversal in Phase 1.
166
+
167
+
~150 lines on top of `ocaml-ewah`.
168
+
169
+
### Phase 5 — `/cap/:hash` + gists
170
+
171
+
- `admin/published/main:manifest.toml` with per-entry signatures.
172
+
- `irmin publish` / `irmin unpublish` CLI.
173
+
- Public `GET /cap/:hash`, parse-failure fail-closed.
174
+
- Gist upload flow: drag file → commit to
175
+
`<owner>/_gists/<id>:main:<filename>` + `meta.toml` → redirect to
176
+
`/g/<id>`.
177
+
- Visibility enforcement per gist.
178
+
- Listing pages: public gist index, per-owner gist page.
179
+
180
+
~300 lines.
181
+
182
+
### Deferred — project/branch ACL overrides
183
+
184
+
Additive to Phase 2: `[[org.project]]` and `[[org.project.branch]]`
185
+
in `org.toml`, same resolver, ~80 more lines. Build when the first
186
+
real user needs per-project sharing. Don't build pre-emptively.
187
+
188
+
## Prerequisites
189
+
190
+
### ocaml-ewah
191
+
192
+
Before Phase 4. Standalone monorepo package following the
193
+
`ocaml-bloom` shape:
194
+
195
+
- `src/ewah.ml(i)`
196
+
- `test/test.ml`, `test_ewah.ml(i)`, hostile cases inlined as a
197
+
`hostile_cases` list
198
+
- `fuzz/fuzz_ewah.ml(i)` with Crowbar + AFL rules
199
+
- `dune-project` with `generate_opam_files true`
200
+
- `ewah.opam.template`
201
+
- `sources.toml` entry pointing at the monorepo subtree remote
202
+
203
+
API shape:
204
+
205
+
```ocaml
206
+
type t
207
+
val empty : t
208
+
val add : t -> int -> t (* set bit at index *)
209
+
val mem : t -> int -> bool
210
+
val cardinal : t -> int
211
+
val union : t -> t -> t
212
+
val inter : t -> t -> t
213
+
val diff : t -> t -> t
214
+
val iter : (int -> unit) -> t -> unit
215
+
val of_bytes : bytes -> (t, [ `Msg of string ]) result
216
+
val to_bytes : t -> bytes
217
+
val of_indices : int list -> t
218
+
val to_indices : t -> int list
219
+
val pp : t Fmt.t
220
+
```
221
+
222
+
Testing ceremony:
223
+
224
+
- Exact expected values for golden cases (not loose comparisons).
225
+
- Hostile cases inlined (empty, single-bit, all-ones word, run
226
+
straddling word boundary, max-length run, bit at index 0 / Int.max).
227
+
- Roundtrip property: `of_bytes (to_bytes t) = Ok t`.
228
+
- Set-algebra properties against a reference `Set.Make(Int)`:
229
+
`of_indices xs |> to_indices = sort_uniq xs`,
230
+
`union a b |> to_indices = Set.union (to_indices a) (to_indices b)`
231
+
etc.
232
+
- Fuzz target: random sequences of add / union / inter / diff against
233
+
the reference set; bytes roundtrip.
234
+
235
+
## Review
236
+
237
+
**Linus**:
238
+
239
+
- 3-segment refs via git's native `refs/heads/x/y/z` — good, don't
240
+
invent a new ref namespace.
241
+
- No `Irmin_refname` module — inline the regex.
242
+
- `Atomic.t` for config swap — good, no locks.
243
+
- Use `tomlt`, don't hand-roll TOML.
244
+
- On parse error: previous config stays live; explicit, not implicit.
245
+
246
+
**Miod**:
247
+
248
+
- TCB audit (HTTP parser, cookie parser, TOML parser) is a
249
+
pre-production blocker, separate from merge.
250
+
- GH ref invariant stated explicitly: delegation only to principals
251
+
named in `admin.toml`; nothing dynamic introduces principals.
252
+
- GH webhook required, not optional. 60-second TTL without it is a
253
+
revocation window.
254
+
- Startup parse failure: refuse to bind, operator recovers via CLI
255
+
(HTTP gate is bypassed because CLI writes the on-disk repo
256
+
directly).
257
+
- Per-entry signatures on `published/manifest.toml` so revocation of
258
+
one author doesn't require rewriting history.
259
+
- Short gist IDs: 16 hex (64 bits) minimum for secret URLs.
260
+
261
+
## Not doing
262
+
263
+
- Per-branch read ACL beyond the org/project level (the commit graph
264
+
leaks history through merges; documented, not designed around).
265
+
- Sigstore / Rekor / witnesses. The Irmin commit graph plus
266
+
allowlist-scoped access is enough for this scope.
267
+
- Capability URLs as the primary auth (only as the opt-in `/cap/`
268
+
and `/g/` flows).
269
+
- `/@me/shared` cross-org discovery (leaks existence).
270
+
- JS in the browser.
+220
-162
bin/cmd_serve.ml
+220
-162
bin/cmd_serve.ml
···
28
28
module H = Tw_html
29
29
module A = Tw_html.At
30
30
31
-
let link_blue ~href text =
32
-
H.a
33
-
~at:[ A.href href ]
34
-
~tw:Tw.[ text blue; hover [ underline ] ]
35
-
[ H.txt text ]
36
-
37
-
let bold_link_blue ~href text =
38
-
H.a
39
-
~at:[ A.href href ]
40
-
~tw:Tw.[ font_semibold; text blue; hover [ underline ] ]
41
-
[ H.txt text ]
42
-
43
-
let cell_right_dim content =
44
-
H.td
45
-
~tw:
46
-
Tw.[ py 1; px 2; text_right; text ~shade:400 gray; text_sm; tabular_nums ]
47
-
content
48
-
49
-
let cell_right_mono content =
50
-
H.td
51
-
~tw:Tw.[ py 1; px 2; text_right; text ~shade:400 gray; text_xs; font_mono ]
52
-
content
31
+
let link_cell ~href ~name ~prefix =
32
+
Table.cell
33
+
[
34
+
H.span ~tw:Tw.[ mr 2; text ~shade:400 gray ] [ H.raw prefix ];
35
+
H.a
36
+
~at:[ A.href href ]
37
+
~tw:
38
+
Tw.
39
+
[
40
+
text ~shade:700 gray;
41
+
font_medium;
42
+
hover [ text Brand.primary ];
43
+
transition;
44
+
]
45
+
[ H.txt name ];
46
+
]
53
47
54
48
let row_dir ~href ~name ~hash =
55
-
H.tr
56
-
~tw:Tw.[ border_b; border_color ~shade:100 gray ]
49
+
Table.row
57
50
[
58
-
H.td ~tw:Tw.[ py 1; px 2 ] [ bold_link_blue ~href (name ^ "/") ];
59
-
cell_right_dim [ H.raw "—" ];
60
-
cell_right_mono [ H.txt hash ];
51
+
link_cell ~href ~name:(name ^ "/") ~prefix:"🗀";
52
+
Table.dim_cell "—";
53
+
Table.mono_cell hash;
61
54
]
62
55
63
56
let row_file ~href ~name ~size ~hash =
64
-
H.tr
65
-
~tw:Tw.[ border_b; border_color ~shade:100 gray ]
57
+
Table.row
66
58
[
67
-
H.td ~tw:Tw.[ py 1; px 2 ] [ link_blue ~href name ];
68
-
cell_right_dim [ H.txt size ];
69
-
cell_right_mono [ H.txt hash ];
59
+
link_cell ~href ~name ~prefix:"🖹";
60
+
Table.dim_cell size;
61
+
Table.mono_cell hash;
70
62
]
71
63
72
64
let table_shell rows =
73
-
let head_cell ?(align = `Left) text =
74
-
let align_tw =
75
-
match align with `Left -> Tw.text_left | `Right -> Tw.text_right
76
-
in
77
-
H.th
78
-
~tw:Tw.[ align_tw; font_medium; text ~shade:500 gray; py 1; px 2 ]
79
-
[ H.txt text ]
80
-
in
81
-
H.table
82
-
~tw:Tw.[ w_full; border_collapse; text_sm ]
83
-
[
84
-
H.thead
85
-
[
86
-
H.tr
87
-
~tw:Tw.[ border_b; border_color ~shade:300 gray ]
88
-
[
89
-
head_cell "Name";
90
-
head_cell ~align:`Right "Size";
91
-
head_cell ~align:`Right "Hash";
92
-
];
93
-
];
94
-
H.tbody rows;
95
-
]
65
+
Table.wrap
66
+
~head:
67
+
(Table.head
68
+
[ ("Name", Table.Left); ("Size", Table.Right); ("Hash", Table.Right) ])
69
+
rows
96
70
97
71
let breadcrumb ~branch ~path =
98
-
let sep = H.span ~tw:Tw.[ mx 1; text ~shade:400 gray ] [ H.raw "›" ] in
99
-
let segments = ref [ link_blue ~href:"/" "/" ] in
72
+
let segments = ref [ ("irmin", "/") ] in
100
73
(match branch with
101
74
| None -> ()
102
75
| Some br ->
103
-
segments :=
104
-
!segments @ [ sep; link_blue ~href:(Fmt.str "/%s/" (url_escape br)) br ];
76
+
segments := !segments @ [ (br, Fmt.str "/%s/" (url_escape br)) ];
105
77
let prefix = ref (Fmt.str "/%s" (url_escape br)) in
106
78
List.iter
107
79
(fun seg ->
108
80
prefix := !prefix ^ "/" ^ url_escape seg;
109
-
segments := !segments @ [ sep; link_blue ~href:(!prefix ^ "/") seg ])
81
+
segments := !segments @ [ (seg, !prefix ^ "/") ])
110
82
path);
111
-
H.div ~tw:Tw.[ mb 3; text_sm ] !segments
83
+
Breadcrumb.v ~segments:!segments
84
+
85
+
let drop_zone = Drop_zone.v
86
+
let summary_p = Layout.summary
87
+
let h1_title = Layout.title_h1
112
88
113
-
let drop_zone ~upload_url ~target_dir =
114
-
H.form
115
-
~at:
116
-
[
117
-
A.action upload_url;
118
-
A.method' "POST";
119
-
A.v "enctype" "multipart/form-data";
120
-
]
121
-
~tw:Tw.[ mt 6 ]
89
+
let section ~title rows =
90
+
H.div
91
+
~tw:Tw.[ mb 8 ]
122
92
[
123
-
H.input ~at:[ A.type' "hidden"; A.name "dir"; A.value target_dir ] ();
124
-
H.label
93
+
H.h2
125
94
~tw:
126
95
Tw.
127
96
[
128
-
block;
129
-
p 5;
130
-
border_md;
131
-
border_dashed;
132
-
border_color ~shade:300 gray;
133
-
rounded_lg;
134
-
text_center;
135
-
text_sm;
136
-
text ~shade:500 gray;
137
-
cursor_pointer;
138
-
transition;
139
-
hover
140
-
[
141
-
border_color ~shade:500 blue;
142
-
text ~shade:600 blue;
143
-
bg ~shade:50 blue;
144
-
];
97
+
text_lg; font_semibold; tracking_tight; text ~shade:800 gray; mb 3;
145
98
]
146
-
[
147
-
H.txt "Drop files here or ";
148
-
H.span ~tw:Tw.[ underline ] [ H.txt "click to browse" ];
149
-
H.input
150
-
~at:
151
-
[
152
-
A.type' "file";
153
-
A.name "file";
154
-
A.v "multiple" "";
155
-
A.onchange
156
-
"this.form.dispatchEvent(new \
157
-
Event('submit',{cancelable:true,bubbles:true}))";
158
-
]
159
-
~tw:Tw.[ hidden ]
160
-
();
161
-
];
99
+
[ H.txt title ];
100
+
rows;
162
101
]
163
102
164
-
let page_footer =
165
-
H.footer
166
-
~tw:Tw.[ mt 8; text_center; text_xs; text ~shade:400 gray ]
167
-
[ H.txt "Served with Irmin" ]
168
-
169
-
(* Auth-aware header strip. Shown above the breadcrumb on every page:
170
-
- auth disabled : nothing
171
-
- auth enabled, no user : "Sign in with GitHub" link
172
-
- auth enabled, user : "<email> [Sign out]" with a POST form *)
173
-
let header_bar ~auth_enabled ~user =
174
-
if not auth_enabled then H.raw ""
175
-
else
176
-
let inner =
177
-
match user with
178
-
| None ->
179
-
[
180
-
H.a
181
-
~at:[ A.href "/auth/github" ]
182
-
~tw:Tw.[ text blue; hover [ underline ] ]
183
-
[ H.txt "Sign in with GitHub" ];
184
-
]
185
-
| Some (u : Auth.user) ->
186
-
[
187
-
H.span ~tw:Tw.[ text ~shade:600 gray ] [ H.txt u.email ];
188
-
H.form
189
-
~at:[ A.action "/auth/signout"; A.method' "POST" ]
190
-
~tw:Tw.[ inline_block; ml 3 ]
191
-
[
192
-
H.button
193
-
~at:[ A.type' "submit" ]
194
-
~tw:Tw.[ text blue; hover [ underline ] ]
195
-
[ H.txt "Sign out" ];
196
-
];
197
-
]
198
-
in
199
-
H.div ~tw:Tw.[ mb 3; text_sm; text_right; text ~shade:500 gray ] inner
200
-
201
-
let summary_p text =
202
-
H.p ~tw:Tw.[ text ~shade:500 gray; text_sm; mb 3 ] [ H.txt text ]
203
-
204
-
let h1_title text = H.h1 ~tw:Tw.[ text_xl; font_light; mb 1 ] [ H.txt text ]
103
+
let kv_row ~label ~value =
104
+
Table.row
105
+
[
106
+
Table.cell ~tw:Tw.[ text ~shade:500 gray; w 40 ] [ H.txt label ];
107
+
Table.cell [ value ];
108
+
]
205
109
206
-
(* Build a Tw_html.page value. Kept separate from rendering so the CSS
207
-
stylesheet can be extracted as well. *)
208
-
let build_page ~title body_content =
209
-
let shell =
210
-
H.div
211
-
~tw:Tw.[ font_mono; max_w_5xl; mx_auto; my 8; px 4; text ~shade:800 gray ]
212
-
(body_content @ [ page_footer ])
213
-
in
214
-
Tw_html.page ~title ~tw_css:"/tw.css" [] [ shell ]
110
+
let auth_state ~auth_enabled ~user : Layout.auth_state =
111
+
match (auth_enabled, user) with
112
+
| false, _ -> Off
113
+
| true, None -> Anon
114
+
| true, Some (u : Auth.user) ->
115
+
Signed_in { email = u.email; name = u.name; avatar_url = u.avatar_url }
215
116
216
-
let page ~title body_content = Tw_html.html (build_page ~title body_content)
117
+
let page ~title ~auth_state body_content =
118
+
Tw_html.html (Layout.page ~title ~auth:auth_state body_content)
217
119
218
120
(* One-shot stylesheet covering every component this module can render.
219
121
Served at [GET /tw.css] so the auto-injected [<link>] in each page
···
225
127
row_file ~href:"/b/f" ~name:"file" ~size:"1B" ~hash:"abcd123";
226
128
]
227
129
in
130
+
let admin_sample =
131
+
section ~title:"sample"
132
+
(Table.wrap
133
+
~head:(Table.head [ ("Field", Table.Left); ("Value", Table.Left) ])
134
+
[
135
+
kv_row ~label:"Signed in as" ~value:(H.txt "sample");
136
+
kv_row ~label:"Status" ~value:(Tag.v ~tone:Tag.Primary "allowed");
137
+
kv_row ~label:"Danger" ~value:(Tag.v ~tone:Tag.Danger "blocked");
138
+
kv_row ~label:"Muted" ~value:(Tag.v ~tone:Tag.Muted "disabled");
139
+
kv_row ~label:"Accent" ~value:(Tag.v ~tone:Tag.Accent "new");
140
+
])
141
+
in
228
142
let body =
229
143
[
230
144
h1_title "sample";
···
232
146
breadcrumb ~branch:(Some "b") ~path:[ "sub" ];
233
147
table_shell sample_rows;
234
148
drop_zone ~upload_url:"/b/upload" ~target_dir:"";
149
+
admin_sample;
235
150
]
236
151
in
237
-
let page = build_page ~title:"css" body in
238
-
let _name, css = Tw_html.css page in
152
+
let sample_page =
153
+
Layout.page ~title:"css"
154
+
~auth:
155
+
(Signed_in
156
+
{
157
+
email = "sample@example.com";
158
+
name = "Sample User";
159
+
avatar_url = "";
160
+
})
161
+
body
162
+
in
163
+
let _name, css = Tw_html.css sample_page in
239
164
Tw.Css.to_string css
240
165
241
166
(* ── Navigation helpers ───────────────────────────────────────────── *)
···
371
296
in
372
297
let body =
373
298
[
374
-
header_bar ~auth_enabled:(Option.is_some auth) ~user;
375
299
h1_title "Branches";
376
300
summary;
377
301
breadcrumb ~branch:None ~path:[];
378
302
table_shell rows;
379
303
]
380
304
in
381
-
Respond.Response.html (page ~title:"Branches" body)
305
+
let auth_state = auth_state ~auth_enabled:(Option.is_some auth) ~user in
306
+
Respond.Response.html (page ~title:"Branches" ~auth_state body)
382
307
383
308
let render_node ?auth ~user ~branch ~path c =
384
309
let entries = S.list c in
···
429
354
let target_dir = String.concat "/" path in
430
355
let body =
431
356
[
432
-
header_bar ~auth_enabled:(Option.is_some auth) ~user;
433
357
h1_title title;
434
358
summary;
435
359
breadcrumb ~branch:(Some branch) ~path;
···
437
361
drop_zone ~upload_url ~target_dir;
438
362
]
439
363
in
440
-
Respond.Response.html (page ~title body)
364
+
let auth_state = auth_state ~auth_enabled:(Option.is_some auth) ~user in
365
+
Respond.Response.html (page ~title ~auth_state body)
441
366
442
367
let render_leaf ~name c =
443
368
match S.get_block c with
···
467
392
let name = List.nth path (List.length path - 1) in
468
393
render_leaf ~name c))
469
394
395
+
let admin_page ?auth heap (req : Respond.get_request) =
396
+
let user = Option.bind auth (fun ctx -> current_user_get ctx req) in
397
+
let allow = upload_allowlist heap in
398
+
let auth_enabled = Option.is_some auth in
399
+
let allowed_here =
400
+
match (auth_enabled, user) with
401
+
| false, _ -> true
402
+
| true, None -> false
403
+
| true, Some u -> is_allowed allow u
404
+
in
405
+
if auth_enabled && not allowed_here then
406
+
let body =
407
+
[
408
+
h1_title "Admin";
409
+
summary_p
410
+
"Access restricted. Sign in with an email on the allowlist to view \
411
+
this page.";
412
+
H.p
413
+
~tw:Tw.[ mt 4 ]
414
+
[
415
+
Button.link_primary
416
+
~at:[ Tw_html.At.href "/auth/github" ]
417
+
[ H.txt "Sign in with GitHub" ];
418
+
];
419
+
]
420
+
in
421
+
let auth_state = auth_state ~auth_enabled ~user in
422
+
Respond.Response.v ~status:403 ~content_type:"text/html"
423
+
(Tw_html.html (Layout.page ~title:"Admin" ~auth:auth_state body))
424
+
else
425
+
let identity_rows =
426
+
match user with
427
+
| None ->
428
+
[
429
+
kv_row ~label:"Signed in as" ~value:(H.txt "(anonymous)");
430
+
kv_row ~label:"Auth"
431
+
~value:
432
+
(if auth_enabled then Tag.v ~tone:Tag.Primary "enabled"
433
+
else Tag.v ~tone:Tag.Muted "disabled");
434
+
]
435
+
| Some (u : Auth.user) ->
436
+
[
437
+
kv_row ~label:"Signed in as" ~value:(H.txt u.name);
438
+
kv_row ~label:"Email" ~value:(H.txt u.email);
439
+
kv_row ~label:"Status"
440
+
~value:
441
+
(if is_allowed allow u then Tag.v ~tone:Tag.Primary "allowed"
442
+
else Tag.v ~tone:Tag.Danger "not allowed");
443
+
]
444
+
in
445
+
let identity_section =
446
+
section ~title:"Identity"
447
+
(Table.wrap
448
+
~head:(Table.head [ ("Field", Table.Left); ("Value", Table.Left) ])
449
+
identity_rows)
450
+
in
451
+
let allow_rows =
452
+
match allow.allow_emails with
453
+
| [] ->
454
+
[
455
+
Table.row
456
+
[
457
+
Table.cell
458
+
~tw:Tw.[ text ~shade:500 gray ]
459
+
[
460
+
H.txt
461
+
"No one. Commit an admin.toml to refs/meta/config to \
462
+
grant upload access.";
463
+
];
464
+
];
465
+
]
466
+
| emails ->
467
+
List.map (fun e -> Table.row [ Table.cell [ H.txt e ] ]) emails
468
+
in
469
+
let allow_section =
470
+
section ~title:"Upload allowlist"
471
+
(Table.wrap ~head:(Table.head [ ("Email", Table.Left) ]) allow_rows)
472
+
in
473
+
let branches = S.branches heap in
474
+
let branch_rows =
475
+
List.map
476
+
(fun name ->
477
+
let hash =
478
+
match S.head heap ~branch:name with
479
+
| None -> "-"
480
+
| Some h ->
481
+
let hex = Irmin.Hash.to_hex h in
482
+
if String.length hex <= 7 then hex else String.sub hex 0 7
483
+
in
484
+
Table.row
485
+
[
486
+
Table.cell
487
+
[
488
+
H.a
489
+
~at:[ Tw_html.At.href (Fmt.str "/%s/" (url_escape name)) ]
490
+
~tw:
491
+
Tw.
492
+
[
493
+
text Brand.primary;
494
+
font_medium;
495
+
hover [ text ~opacity:80 Brand.primary ];
496
+
]
497
+
[ H.txt name ];
498
+
];
499
+
Table.mono_cell hash;
500
+
])
501
+
branches
502
+
in
503
+
let branch_section =
504
+
section ~title:"Branches"
505
+
(Table.wrap
506
+
~head:(Table.head [ ("Name", Table.Left); ("Head", Table.Right) ])
507
+
branch_rows)
508
+
in
509
+
let body =
510
+
[
511
+
h1_title "Admin";
512
+
summary_p
513
+
(Fmt.str "%d branch%s, %d email%s on the upload allowlist."
514
+
(List.length branches)
515
+
(if List.length branches = 1 then "" else "es")
516
+
(List.length allow.allow_emails)
517
+
(if List.length allow.allow_emails = 1 then "" else "s"));
518
+
breadcrumb ~branch:None ~path:[];
519
+
identity_section;
520
+
allow_section;
521
+
branch_section;
522
+
]
523
+
in
524
+
let auth_state = auth_state ~auth_enabled ~user in
525
+
Respond.Response.html (page ~title:"Admin" ~auth_state body)
526
+
470
527
let raw_block heap (req : Respond.get_request) =
471
528
let hex = List.assoc "hash" req.path_params in
472
529
match Irmin.Hash.sha1_of_hex hex with
···
612
669
[ css_route ] @ auth_routes
613
670
@ [
614
671
get "/" (branches_page ?auth heap);
672
+
get "/admin" (admin_page ?auth heap);
615
673
get "/blocks/:hash" (raw_block heap);
616
674
post "/:branch/upload" (upload ?auth heap);
617
675
get "/:branch/**" (browse ?auth heap);
+1
bin/dune
+1
bin/dune
+1
lib/admin/irmin_admin.mli
+1
lib/admin/irmin_admin.mli
+2
-2
lib/hash.mli
+2
-2
lib/hash.mli
···
104
104
(** Structural equality: both the algorithm and the byte content must match. *)
105
105
106
106
val compare_any : any -> any -> int
107
-
(** Total order on [any]. Algorithms compare first (Sha1 < Sha256), then bytes
108
-
lexicographically. *)
107
+
(** [compare_any a b] is a total order on [any]. Algorithms compare first (Sha1
108
+
< Sha256), then bytes lexicographically. *)
109
109
110
110
val any_of_bytes : algorithm -> string -> any
111
111
(** [any_of_bytes algo raw] packages [raw] (of the length required by [algo])
+22
-3
lib/mime/irmin_mime.mli
+22
-3
lib/mime/irmin_mime.mli
···
11
11
[Magic_mime.lookup] returns for the standard extensions. *)
12
12
13
13
val json : string
14
+
(** [json] is ["application/json"]. *)
15
+
14
16
val yaml : string
17
+
(** [yaml] is ["application/yaml"]. *)
18
+
15
19
val toml : string
20
+
(** [toml] is ["application/toml"]. *)
21
+
16
22
val cbor : string
23
+
(** [cbor] is ["application/cbor"]. *)
24
+
17
25
val tar : string
26
+
(** [tar] is ["application/x-tar"]. *)
27
+
18
28
val gzip : string
29
+
(** [gzip] is ["application/gzip"]. *)
30
+
19
31
val oci_manifest : string
32
+
(** [oci_manifest] is ["application/vnd.oci.image.manifest.v1+json"]. *)
33
+
20
34
val text_plain : string
35
+
(** [text_plain] is ["text/plain"]. *)
36
+
21
37
val text_markdown : string
38
+
(** [text_markdown] is ["text/markdown"]. *)
39
+
22
40
val octet_stream : string
41
+
(** [octet_stream] is ["application/octet-stream"]. *)
23
42
24
43
(** {1 Codec rules bundle}
25
44
···
28
47
smaller subset pass their own list to {!Irmin.Schema.mime_rules}. *)
29
48
30
49
val rules : unit -> Irmin.SHA256.rule list
31
-
(** All built-in codec rules: [json], [yaml], [toml], [cbor], [tar],
32
-
[oci_manifest], [text_plain], [text_markdown], plus gzip-wrapped variants
33
-
dispatched by filename pattern ([*.tar.gz], [*.tgz], [*.json.gz],
50
+
(** [rules ()] returns all built-in codec rules: [json], [yaml], [toml], [cbor],
51
+
[tar], [oci_manifest], [text_plain], [text_markdown], plus gzip-wrapped
52
+
variants dispatched by filename pattern ([*.tar.gz], [*.tgz], [*.json.gz],
34
53
[*.yaml.gz]). First match wins per {!Irmin.Schema.mime_rules}. *)
+2
-2
lib/text/irmin_text.mli
+2
-2
lib/text/irmin_text.mli
···
8
8
module S = Irmin.SHA256
9
9
10
10
val plain : string S.t
11
-
(** [text/plain] with line-level merge. *)
11
+
(** [plain] is a ["text/plain"] leaf codec with line-level merge. *)
12
12
13
13
val markdown : string S.t
14
-
(** [text/markdown] with line-level merge. *)
14
+
(** [markdown] is a ["text/markdown"] leaf codec with line-level merge. *)
+30
lib/ui/brand.ml
+30
lib/ui/brand.ml
···
1
+
(** Irmin brand palette and logo. *)
2
+
3
+
module H = Tw_html
4
+
module A = Tw_html.At
5
+
6
+
let primary = Tw.hex "#09AB82"
7
+
let secondary = Tw.hex "#05A6BD"
8
+
let accent = Tw.hex "#0CAD67"
9
+
10
+
(* Exact Irmin logo (icon + "rmin" wordmark) lifted from irmin.org's
11
+
src/images/logo.svg. The icon on the left doubles as the "I" of
12
+
"Irmin" -- the text path renders only "rmin". Kept as raw markup
13
+
since Tw_html's DSL does not cover SVG primitives. *)
14
+
let logo_svg =
15
+
{|<svg height="28" viewBox="0 0 519 185" fill="none" xmlns="http://www.w3.org/2000/svg" aria-label="Irmin">
16
+
<path fill-rule="evenodd" clip-rule="evenodd" d="M206 155V49H221.893V155H206ZM273.678 82.92C280.864 82.92 286.438 84.6631 290.4 88.1493L283.075 99.3147C280.311 97.6187 276.902 96.7707 272.849 96.7707C267.966 96.7707 263.704 98.6787 260.065 102.495C256.426 106.311 254.606 111.187 254.606 117.123V155H239.266V84.3333H253.224L254.054 94.2267C259.582 86.6889 266.123 82.92 273.678 82.92ZM375.629 82.92C383.276 82.92 389.495 85.4169 394.286 90.4107C399.077 95.4044 401.472 101.859 401.472 109.773V155H385.994V111.611C385.994 107.371 384.635 103.837 381.917 101.011C379.199 98.184 375.767 96.7707 371.621 96.7707C367.199 96.7707 363.513 98.3018 360.565 101.364C357.617 104.426 356.143 108.172 356.143 112.6V155H340.665V111.611C340.665 107.371 339.306 103.837 336.588 101.011C333.87 98.184 330.438 96.7707 326.292 96.7707C321.962 96.7707 318.276 98.3018 315.236 101.364C312.196 104.426 310.676 108.172 310.676 112.6V155H295.336V84.3333H309.294L309.985 91.9653C315.42 85.9351 322.238 82.92 330.438 82.92C340.204 82.92 347.436 86.8302 352.135 94.6507C357.847 86.8302 365.679 82.92 375.629 82.92ZM428.105 71.6133C425.525 71.6133 423.314 70.6947 421.471 68.8573C419.629 67.02 418.707 64.7822 418.707 62.144C418.707 59.5058 419.629 57.2444 421.471 55.36C423.314 53.4756 425.525 52.5333 428.105 52.5333C430.685 52.5333 432.896 53.4756 434.738 55.36C436.581 57.2444 437.502 59.5058 437.502 62.144C437.502 64.7822 436.581 67.02 434.738 68.8573C432.896 70.6947 430.685 71.6133 428.105 71.6133ZM420.366 155V84.3333H435.706V155H420.366ZM492.051 82.92C499.883 82.92 506.332 85.464 511.399 90.552C516.466 95.64 519 102.236 519 110.339V155H503.522V112.176C503.522 107.748 502.025 104.073 499.03 101.152C496.036 98.2311 492.236 96.7707 487.629 96.7707C482.93 96.7707 478.945 98.3489 475.675 101.505C472.404 104.662 470.769 108.501 470.769 113.024V155H455.429V84.3333H469.387L470.216 92.672C475.836 86.1707 483.114 82.92 492.051 82.92Z" fill="#09AB82"/>
17
+
<path fill-rule="evenodd" clip-rule="evenodd" d="M70.3105 52.9483C70.283 51.8036 70.9563 50.6986 72.1822 49.8765C73.4081 49.0544 75.0863 48.5825 76.8475 48.5647C78.6447 48.5464 80.3765 49.0024 81.6475 49.8285C82.9184 50.6546 83.62 51.7802 83.5919 52.9483V79.253L112.051 50.5784C113.256 49.3364 114.893 48.615 116.617 48.5667C119.35 48.4913 121.849 50.1091 122.915 52.6433C123.981 55.1776 123.397 58.1108 121.443 60.035L83.5919 98.1729V118.72C83.593 118.789 83.593 118.859 83.5919 118.928V126.089L112.051 97.4147C113.256 96.1728 114.893 95.4513 116.617 95.403C119.35 95.3277 121.849 96.9455 122.915 99.4797C123.981 102.014 123.397 104.947 121.443 106.871L83.5919 145.009V180.386L77.4725 184.015L70.3105 179.73V142.344C70.3095 142.274 70.3095 142.205 70.3105 142.135V121.587L32.4834 83.4722C30.5394 81.5781 29.9311 78.6858 30.9455 76.1607C31.96 73.6356 34.3943 71.9827 37.0994 71.9823C38.8984 71.9825 40.6204 72.7178 41.8711 74.0199L70.3105 102.675V95.5073C70.3095 95.4377 70.3095 95.3681 70.3105 95.2987V52.9483ZM77.5 0L155 46V138L77.5 184L0 138V46L77.5 0Z" fill="url(#irmin-brand-gradient)"/>
18
+
<defs>
19
+
<linearGradient id="irmin-brand-gradient" x1="117.301" y1="286.84" x2="367.743" y2="86.727" gradientUnits="userSpaceOnUse">
20
+
<stop stop-color="#0CAD67"/>
21
+
<stop offset="1" stop-color="#05A6BD"/>
22
+
</linearGradient>
23
+
</defs>
24
+
</svg>|}
25
+
26
+
let logo =
27
+
H.a
28
+
~at:[ A.href "/" ]
29
+
~tw:Tw.[ inline_flex; items_center; transition; hover [ opacity 80 ] ]
30
+
[ H.raw logo_svg ]
+16
lib/ui/brand.mli
+16
lib/ui/brand.mli
···
1
+
(** Irmin brand palette and logo.
2
+
3
+
Colours sourced from irmin.org. Logo is a teal-to-blue gradient diamond
4
+
rendered as inline SVG alongside the wordmark. *)
5
+
6
+
val primary : Tw.color
7
+
(** [primary] is Irmin's primary green ([#09AB82]). *)
8
+
9
+
val secondary : Tw.color
10
+
(** [secondary] is Irmin's teal-blue ([#05A6BD]). *)
11
+
12
+
val accent : Tw.color
13
+
(** [accent] is the accent green used for gradient tips ([#0CAD67]). *)
14
+
15
+
val logo : Tw_html.t
16
+
(** [logo] is the Irmin diamond SVG + wordmark, wrapped as a link to [/]. *)
+65
lib/ui/drop_zone.ml
+65
lib/ui/drop_zone.ml
···
1
+
(** Drag-and-drop file upload zone. *)
2
+
3
+
module H = Tw_html
4
+
module A = Tw_html.At
5
+
6
+
let v ~upload_url ~target_dir =
7
+
H.form
8
+
~at:
9
+
[
10
+
A.action upload_url;
11
+
A.method' "POST";
12
+
A.v "enctype" "multipart/form-data";
13
+
]
14
+
~tw:Tw.[ mt 6 ]
15
+
[
16
+
H.input ~at:[ A.type' "hidden"; A.name "dir"; A.value target_dir ] ();
17
+
H.label
18
+
~tw:
19
+
Tw.
20
+
[
21
+
block;
22
+
px 6;
23
+
py 8;
24
+
border_md;
25
+
border_dashed;
26
+
border_color ~shade:300 gray;
27
+
rounded_xl;
28
+
text_center;
29
+
text_sm;
30
+
text ~shade:600 gray;
31
+
bg white;
32
+
cursor_pointer;
33
+
transition;
34
+
hover
35
+
[
36
+
border_color Brand.primary;
37
+
text Brand.primary;
38
+
bg ~opacity:5 Brand.primary;
39
+
];
40
+
]
41
+
[
42
+
H.div
43
+
~tw:Tw.[ mb 2; text_2xl; text ~shade:400 gray ]
44
+
[ H.raw "↥" ];
45
+
H.div
46
+
[
47
+
H.txt "Drop files here or ";
48
+
H.span
49
+
~tw:Tw.[ text Brand.primary; font_medium; underline ]
50
+
[ H.txt "click to browse" ];
51
+
];
52
+
H.input
53
+
~at:
54
+
[
55
+
A.type' "file";
56
+
A.name "file";
57
+
A.v "multiple" "";
58
+
A.onchange
59
+
"this.form.dispatchEvent(new \
60
+
Event('submit',{cancelable:true,bubbles:true}))";
61
+
]
62
+
~tw:Tw.[ hidden ]
63
+
();
64
+
];
65
+
]
+8
lib/ui/drop_zone.mli
+8
lib/ui/drop_zone.mli
···
1
+
(** Drag-and-drop file upload zone.
2
+
3
+
Renders a [<form>] that POSTs [multipart/form-data] to [upload_url] with a
4
+
hidden [dir] field carrying [target_dir] and a visually styled file-input
5
+
label. The file input auto-submits on change so no JavaScript framework is
6
+
required. *)
7
+
8
+
val v : upload_url:string -> target_dir:string -> Tw_html.t
+5
lib/ui/dune
+5
lib/ui/dune
+12
lib/ui/irmin_ui.ml
+12
lib/ui/irmin_ui.ml
···
1
+
(** UI component library for Irmin's HTTP pages.
2
+
3
+
Each module covers one visual concept; pages compose them via
4
+
{!Layout.page}. *)
5
+
6
+
module Brand = Brand
7
+
module Breadcrumb = Breadcrumb
8
+
module Button = Button
9
+
module Drop_zone = Drop_zone
10
+
module Layout = Layout
11
+
module Table = Table
12
+
module Tag = Tag
+127
lib/ui/layout.ml
+127
lib/ui/layout.ml
···
1
+
(** Page shell. *)
2
+
3
+
module H = Tw_html
4
+
module A = Tw_html.At
5
+
6
+
type auth_state =
7
+
| Off
8
+
| Anon
9
+
| Signed_in of { email : string; name : string; avatar_url : string }
10
+
11
+
let avatar ~name ~avatar_url =
12
+
let initials =
13
+
match String.trim name with
14
+
| "" -> "?"
15
+
| n ->
16
+
let c = Char.uppercase_ascii n.[0] in
17
+
String.make 1 c
18
+
in
19
+
if avatar_url = "" then
20
+
H.span
21
+
~tw:
22
+
Tw.
23
+
[
24
+
inline_flex;
25
+
items_center;
26
+
justify_center;
27
+
w 8;
28
+
h 8;
29
+
rounded_full;
30
+
bg ~shade:100 gray;
31
+
text ~shade:600 gray;
32
+
text_xs;
33
+
font_semibold;
34
+
]
35
+
[ H.txt initials ]
36
+
else
37
+
H.img
38
+
~at:[ A.src avatar_url; A.alt name ]
39
+
~tw:Tw.[ w 8; h 8; rounded_full; border; border_color ~shade:200 gray ]
40
+
()
41
+
42
+
let header auth =
43
+
let right =
44
+
match auth with
45
+
| Off -> []
46
+
| Anon ->
47
+
[
48
+
Button.link_primary
49
+
~at:[ A.href "/auth/github" ]
50
+
[ H.txt "Sign in with GitHub" ];
51
+
]
52
+
| Signed_in { email; name; avatar_url } ->
53
+
let display = match String.trim name with "" -> email | n -> n in
54
+
[
55
+
H.a
56
+
~at:[ A.href "/admin" ]
57
+
~tw:
58
+
Tw.
59
+
[
60
+
mr 4;
61
+
text ~shade:500 gray;
62
+
text_sm;
63
+
font_medium;
64
+
transition;
65
+
hover [ text ~shade:900 gray ];
66
+
]
67
+
[ H.txt "Admin" ];
68
+
avatar ~name ~avatar_url;
69
+
H.span
70
+
~tw:Tw.[ mx 3; text ~shade:700 gray; text_sm; font_medium ]
71
+
~at:[ A.title email ]
72
+
[ H.txt display ];
73
+
H.form
74
+
~at:[ A.action "/auth/signout"; A.method' "POST" ]
75
+
~tw:Tw.[ inline_block ]
76
+
[ Button.secondary ~at:[ A.type' "submit" ] [ H.txt "Sign out" ] ];
77
+
]
78
+
in
79
+
H.header
80
+
~tw:
81
+
Tw.
82
+
[
83
+
flex;
84
+
items_center;
85
+
justify_between;
86
+
py 4;
87
+
mb 8;
88
+
border_b;
89
+
border_color ~shade:200 gray;
90
+
]
91
+
[ Brand.logo; H.div ~tw:Tw.[ flex; items_center ] right ]
92
+
93
+
let footer =
94
+
H.footer
95
+
~tw:
96
+
Tw.
97
+
[
98
+
mt 12;
99
+
pt 6;
100
+
pb 4;
101
+
border_t;
102
+
border_color ~shade:200 gray;
103
+
text_center;
104
+
text_xs;
105
+
text ~shade:400 gray;
106
+
]
107
+
[ H.txt "Served with Irmin" ]
108
+
109
+
let title_h1 text =
110
+
H.h1
111
+
~tw:
112
+
Tw.[ text_2xl; font_semibold; tracking_tight; text ~shade:900 gray; mb 2 ]
113
+
[ H.txt text ]
114
+
115
+
let summary text =
116
+
H.p ~tw:Tw.[ text ~shade:500 gray; text_sm; mb 5 ] [ H.txt text ]
117
+
118
+
let page ~title ~auth content =
119
+
let shell =
120
+
H.div
121
+
~tw:Tw.[ max_w_5xl; mx_auto; px 6; text ~shade:700 gray ]
122
+
([ header auth ] @ content @ [ footer ])
123
+
in
124
+
let body =
125
+
H.div ~tw:Tw.[ bg ~shade:50 gray; font_sans; min_h_screen ] [ shell ]
126
+
in
127
+
Tw_html.page ~title ~tw_css:"/tw.css" [] [ body ]
+24
lib/ui/layout.mli
+24
lib/ui/layout.mli
···
1
+
(** Top-level page shell: header, content container, footer.
2
+
3
+
The header shows the brand on the left and optional auth controls on the
4
+
right. The footer is a neutral "Served with Irmin" strip. The content area
5
+
is a max-width wrapper with system-font body text and a tinted grey
6
+
background. *)
7
+
8
+
type auth_state =
9
+
| Off (** Auth is disabled: header shows no controls on the right. *)
10
+
| Anon (** Auth is on but no active session: shows "Sign in with GitHub". *)
11
+
| Signed_in of { email : string; name : string; avatar_url : string }
12
+
(** Signed-in user; header renders an avatar + display name and a sign-out
13
+
form. Falls back to initials when [avatar_url = ""] and to [email]
14
+
when [name = ""]. *)
15
+
16
+
val page : title:string -> auth:auth_state -> Tw_html.t list -> Tw_html.page
17
+
(** [page ~title ~auth content] builds a full-page [Tw_html.page]. Use
18
+
{!Tw_html.html} to render HTML and {!Tw_html.css} for the stylesheet. *)
19
+
20
+
val title_h1 : string -> Tw_html.t
21
+
(** [title_h1 text] is the main H1 heading style used by every page. *)
22
+
23
+
val summary : string -> Tw_html.t
24
+
(** [summary text] is a small muted paragraph, sized for summaries. *)
+73
lib/ui/table.ml
+73
lib/ui/table.ml
···
1
+
(** Data tables. *)
2
+
3
+
module H = Tw_html
4
+
5
+
type align = Left | Right | Center
6
+
7
+
let align_tw = function
8
+
| Left -> Tw.text_left
9
+
| Right -> Tw.text_right
10
+
| Center -> Tw.text_center
11
+
12
+
(* [col] is a convenience for caller readability; the alignment travels
13
+
in the tuple used by [head]. The string here is just the label. *)
14
+
let col ?align:_ label = label
15
+
16
+
let head cols =
17
+
let th (label, al) =
18
+
H.th
19
+
~tw:
20
+
Tw.
21
+
[
22
+
align_tw al;
23
+
py 2;
24
+
px 3;
25
+
text_xs;
26
+
font_medium;
27
+
text ~shade:500 gray;
28
+
uppercase;
29
+
tracking_wider;
30
+
bg ~shade:50 gray;
31
+
border_b;
32
+
border_color ~shade:200 gray;
33
+
]
34
+
[ H.txt label ]
35
+
in
36
+
H.thead [ H.tr (List.map th cols) ]
37
+
38
+
let row ?(at = []) cells =
39
+
H.tr ~at ~tw:Tw.[ hover [ bg ~shade:50 gray ]; transition ] cells
40
+
41
+
let cell ?(align = Left) ?(tw = []) children =
42
+
H.td
43
+
~tw:
44
+
(Tw.[ align_tw align; py 2; px 3; border_b; border_color ~shade:100 gray ]
45
+
@ tw)
46
+
children
47
+
48
+
let dim_cell ?(align = Right) text =
49
+
cell ~align
50
+
~tw:Tw.[ tabular_nums; text_sm; text ~shade:500 gray ]
51
+
[ H.txt text ]
52
+
53
+
let mono_cell ?(align = Right) text =
54
+
cell ~align
55
+
[
56
+
H.span ~tw:Tw.[ font_mono; text_xs; text ~shade:500 gray ] [ H.txt text ];
57
+
]
58
+
59
+
let wrap ~head rows =
60
+
H.div
61
+
~tw:
62
+
Tw.
63
+
[
64
+
rounded_lg;
65
+
border;
66
+
border_color ~shade:200 gray;
67
+
bg white;
68
+
overflow_hidden;
69
+
shadow_sm;
70
+
]
71
+
[
72
+
H.table ~tw:Tw.[ w_full; border_collapse; text_sm ] [ head; H.tbody rows ];
73
+
]
+31
lib/ui/table.mli
+31
lib/ui/table.mli
···
1
+
(** Data tables with consistent styling.
2
+
3
+
The table is wrapped in a rounded card, header rows have a tinted background
4
+
and uppercase labels, and each body row highlights on hover. *)
5
+
6
+
type align = Left | Right | Center
7
+
8
+
val col : ?align:align -> string -> string
9
+
(** [col ?align label] is a logical column spec: a header label plus its
10
+
alignment. Only the alignment is conveyed through the string value (opaque
11
+
to callers). *)
12
+
13
+
val head : (string * align) list -> Tw_html.t
14
+
(** [head cols] renders the [<thead>] for the given columns. Each column is a
15
+
[(label, alignment)] pair. *)
16
+
17
+
val row : ?at:Tw_html.attr list -> Tw_html.t list -> Tw_html.t
18
+
(** [row ?at cells] renders a single striped body row with hover. *)
19
+
20
+
val cell : ?align:align -> ?tw:Tw.t list -> Tw_html.t list -> Tw_html.t
21
+
(** [cell ?align ?tw children] is a [<td>] with the shared padding and optional
22
+
alignment. *)
23
+
24
+
val dim_cell : ?align:align -> string -> Tw_html.t
25
+
(** [dim_cell ?align text] is a muted-coloured text cell. *)
26
+
27
+
val mono_cell : ?align:align -> string -> Tw_html.t
28
+
(** [mono_cell ?align text] is a small monospace cell (for hashes). *)
29
+
30
+
val wrap : head:Tw_html.t -> Tw_html.t list -> Tw_html.t
31
+
(** [wrap ~head rows] puts [head] and [rows] inside the card-shell table. *)
+52
lib/ui/tag.ml
+52
lib/ui/tag.ml
···
1
+
(** Pill-shaped badges. *)
2
+
3
+
module H = Tw_html
4
+
5
+
type tone = Neutral | Primary | Accent | Muted | Danger
6
+
7
+
let tone_tw = function
8
+
| Neutral ->
9
+
Tw.
10
+
[
11
+
bg ~shade:100 gray; text ~shade:700 gray; border_color ~shade:200 gray;
12
+
]
13
+
| Primary ->
14
+
Tw.
15
+
[
16
+
bg ~opacity:10 Brand.primary;
17
+
text Brand.primary;
18
+
border_color ~opacity:20 Brand.primary;
19
+
]
20
+
| Accent ->
21
+
Tw.
22
+
[
23
+
bg ~opacity:10 Brand.accent;
24
+
text Brand.accent;
25
+
border_color ~opacity:20 Brand.accent;
26
+
]
27
+
| Muted ->
28
+
Tw.
29
+
[
30
+
bg ~shade:50 gray; text ~shade:500 gray; border_color ~shade:100 gray;
31
+
]
32
+
| Danger ->
33
+
Tw.[ bg ~shade:50 red; text ~shade:700 red; border_color ~shade:200 red ]
34
+
35
+
let base =
36
+
Tw.
37
+
[
38
+
inline_flex;
39
+
items_center;
40
+
px 2;
41
+
py_px;
42
+
rounded_full;
43
+
border;
44
+
text_xs;
45
+
font_medium;
46
+
tracking_wide;
47
+
]
48
+
49
+
let v ?(tone = Neutral) text = H.span ~tw:(base @ tone_tw tone) [ H.txt text ]
50
+
51
+
let mono ?(tone = Neutral) text =
52
+
H.span ~tw:(base @ tone_tw tone @ Tw.[ font_mono ]) [ H.txt text ]
+12
lib/ui/tag.mli
+12
lib/ui/tag.mli
···
1
+
(** Small pill-shaped badges for metadata (branch names, hashes, file counts,
2
+
auth status, ...). *)
3
+
4
+
type tone = Neutral | Primary | Accent | Muted | Danger
5
+
6
+
val v : ?tone:tone -> string -> Tw_html.t
7
+
(** [v ?tone text] renders [text] inside a rounded pill. Default tone is
8
+
{!Neutral}. *)
9
+
10
+
val mono : ?tone:tone -> string -> Tw_html.t
11
+
(** [mono ?tone text] is like {!v} but in a monospace font, suitable for short
12
+
hashes. *)