objective categorical abstract machine language personal data server
Admin blobs page
+429
-11
+3
bin/main.ml
+3
bin/main.ml
···
52
52
; (post, "/admin/users", Api.Admin_.Users.post_handler)
53
53
; (get, "/admin/invites", Api.Admin_.Invites.get_handler)
54
54
; (post, "/admin/invites", Api.Admin_.Invites.post_handler)
55
+
; (get, "/admin/blobs", Api.Admin_.Blobs.get_handler)
56
+
; (post, "/admin/blobs", Api.Admin_.Blobs.post_handler)
57
+
; (get, "/admin/blobs/view", Api.Admin_.Blobs.view_handler)
55
58
; (* unauthed *)
56
59
( get
57
60
, "/xrpc/com.atproto.server.describeServer"
+2
-1
frontend/client/Router.mlx
+2
-1
frontend/client/Router.mlx
···
22
22
; {path= "/account/permissions"; template= (module AccountPermissionsPage)}
23
23
; {path= "/admin/login"; template= (module AdminLoginPage)}
24
24
; {path= "/admin/users"; template= (module AdminUsersPage)}
25
-
; {path= "/admin/invites"; template= (module AdminInvitesPage)} ]
25
+
; {path= "/admin/invites"; template= (module AdminInvitesPage)}
26
+
; {path= "/admin/blobs"; template= (module AdminBlobsPage)} ]
26
27
27
28
let find_by_path path_to_find =
28
29
List.find_opt
+12
frontend/src/components/AdminSidebar.mlx
+12
frontend/src/components/AdminSidebar.mlx
+205
frontend/src/templates/AdminBlobsPage.mlx
+205
frontend/src/templates/AdminBlobsPage.mlx
···
1
+
[@@@ocaml.warning "-26-27"]
2
+
3
+
open Melange_json.Primitives
4
+
open React
5
+
6
+
type blob =
7
+
{ did: string
8
+
; handle: string
9
+
; user_created_at: string
10
+
; cid: string
11
+
; mimetype: string
12
+
; storage: string
13
+
; size: string }
14
+
[@@deriving json]
15
+
16
+
type props =
17
+
{ blobs: blob list
18
+
; csrf_token: string
19
+
; cursor: string
20
+
; next_cursor: string option [@default None]
21
+
; error: string option [@default None]
22
+
; success: string option [@default None] }
23
+
[@@deriving json]
24
+
25
+
let is_image mimetype =
26
+
String.starts_with ~prefix:"image/" mimetype
27
+
28
+
let is_video mimetype =
29
+
String.starts_with ~prefix:"video/" mimetype
30
+
31
+
let[@react.component] make
32
+
~props:
33
+
({ blobs
34
+
; csrf_token
35
+
; cursor
36
+
; next_cursor
37
+
; error
38
+
; success } :
39
+
props ) () =
40
+
let deleteConfirmFor, setDeleteConfirmFor = useState (fun () -> (None : blob option)) in
41
+
<div className="w-full h-full max-w-4xl px-4 pt-16 mx-auto flex flex-col md:flex-row gap-12">
42
+
<AdminSidebar active_page="/admin/blobs" />
43
+
<main className="flex-1 w-full">
44
+
<h1 className="text-2xl font-serif text-mana-200 mb-1">
45
+
(string "blobs")
46
+
</h1>
47
+
<p className="text-mist-100 mb-4">
48
+
(string "View and manage all blobs stored on this PDS.")
49
+
</p>
50
+
( match error with
51
+
| Some err ->
52
+
<div className="mb-4">
53
+
<span className="inline-flex items-center text-phoenix-100 text-sm">
54
+
<CircleAlertIcon className="w-4 h-4 mr-2" /> (string err)
55
+
</span>
56
+
</div>
57
+
| None -> null )
58
+
( match success with
59
+
| Some msg ->
60
+
<div className="mb-4">
61
+
<span className="inline-flex items-center text-mana-100 text-sm">
62
+
<CheckmarkIcon className="w-4 h-4 mr-2" /> (string msg)
63
+
</span>
64
+
</div>
65
+
| None -> null )
66
+
( if List.length blobs = 0 then
67
+
<div className="mt-12 text-center text-mist-80">
68
+
<p>(string "No blobs found.")</p>
69
+
</div>
70
+
else
71
+
<div className="grid grid-cols-3 sm:grid-cols-4 gap-3 mb-6">
72
+
( List.map
73
+
(fun (blob : blob) ->
74
+
let view_url = "/admin/blobs/view?did=" ^ blob.did ^ "&cid=" ^ blob.cid in
75
+
let is_img = is_image blob.mimetype in
76
+
let is_vid = is_video blob.mimetype in
77
+
<a
78
+
href=view_url
79
+
target="_blank"
80
+
rel="noopener noreferrer"
81
+
key=(blob.did ^ "-" ^ blob.cid)
82
+
className="group border border-mist-60/50 rounded-lg overflow-hidden bg-feather-100 hover:border-mana-100 hover:shadow-md transition-all">
83
+
<div className="block aspect-[4/3] bg-mist-60/20 relative overflow-hidden">
84
+
( if is_img then
85
+
<img
86
+
src=view_url
87
+
alt="blob preview"
88
+
className="w-full h-full object-cover"
89
+
/>
90
+
else if is_vid then
91
+
<div className="w-full h-full flex flex-col items-center justify-center text-mist-80">
92
+
<UploadIcon className="w-8 h-8 mb-1" />
93
+
<span className="text-xs">(string "Video")</span>
94
+
</div>
95
+
else
96
+
<div className="flex flex-col items-center justify-center text-mist-80 h-full px-2">
97
+
<UploadIcon className="w-8 h-8 mb-1" />
98
+
<span className="text-xs text-center break-all line-clamp-2">
99
+
(string (if blob.mimetype = "*/*" then "Unknown" else blob.mimetype))
100
+
</span>
101
+
</div> )
102
+
<div className="absolute inset-0 bg-mist-80/0 group-hover:bg-mist-80/60 transition-colors flex items-center justify-center opacity-0 group-hover:opacity-100">
103
+
<button
104
+
onClick=(fun e ->
105
+
Event.Mouse.preventDefault e ;
106
+
Event.Mouse.stopPropagation e ;
107
+
setDeleteConfirmFor (fun _ -> Some blob))
108
+
className="px-3 py-2 bg-phoenix-100 hover:bg-phoenix-80 text-feather-100 rounded-lg shadow-lg transition-colors flex items-center gap-2">
109
+
<TrashIcon className="w-4 h-4" />
110
+
<span className="text-sm">(string "Delete")</span>
111
+
</button>
112
+
</div>
113
+
</div>
114
+
<div className="p-2 bg-feather-100">
115
+
<p className="text-xs text-mana-100 font-medium truncate mb-1" title=blob.handle>
116
+
(string blob.handle)
117
+
</p>
118
+
<div className="flex items-center justify-between text-xs text-mist-80">
119
+
<span>(string blob.size)</span>
120
+
<span className="px-1.5 py-0.5 rounded bg-mist-60/30 text-mist-100">
121
+
(string blob.storage)
122
+
</span>
123
+
</div>
124
+
</div>
125
+
</a> )
126
+
blobs
127
+
|> Array.of_list |> array )
128
+
</div> )
129
+
( match next_cursor with
130
+
| Some cursor ->
131
+
<div className="mt-6 flex justify-center">
132
+
<a href=("?cursor=" ^ cursor)>
133
+
<Button kind=`Secondary>(string "Load more")</Button>
134
+
</a>
135
+
</div>
136
+
| None -> null )
137
+
<ClientOnly fallback=null>
138
+
[%browser_only
139
+
(fun () ->
140
+
let module Aria = ReactAria in
141
+
<Aria.DialogTrigger
142
+
isOpen=(deleteConfirmFor <> None)
143
+
onOpenChange=(fun o -> if not o then setDeleteConfirmFor (fun _ -> None))>
144
+
<Aria.ModalOverlay
145
+
className="fixed inset-0 z-50 bg-mist-80/80 flex items-center justify-center"
146
+
isDismissable=true>
147
+
<Aria.Modal
148
+
className="bg-feather-100 border border-mist-60 rounded-xl px-6 pb-6 pt-5 w-full max-w-sm mx-4 shadow-xl">
149
+
<Aria.Dialog className="outline-none">
150
+
( match deleteConfirmFor with
151
+
| Some blob ->
152
+
let view_url = "/admin/blobs/view?did=" ^ blob.did ^ "&cid=" ^ blob.cid in
153
+
let is_img = is_image blob.mimetype in
154
+
<form className="flex flex-col gap-y-2">
155
+
<Aria.Heading
156
+
slot="title"
157
+
className="text-lg font-serif text-mana-200 mb-2">
158
+
(string "delete blob")
159
+
</Aria.Heading>
160
+
<input type_="hidden" name="dream.csrf" value=csrf_token />
161
+
<input type_="hidden" name="action" value="delete_blob" />
162
+
<input type_="hidden" name="did" value=blob.did />
163
+
<input type_="hidden" name="cid" value=blob.cid />
164
+
( if is_img then
165
+
<div className="mb-2 rounded overflow-hidden border border-mist-60/50">
166
+
<img
167
+
src=view_url
168
+
alt="blob preview"
169
+
className="w-full h-auto"
170
+
/>
171
+
</div>
172
+
else null )
173
+
<p className="text-mist-100 mb-2">
174
+
(string ("Delete this blob from " ^ blob.handle ^ "?"))
175
+
</p>
176
+
<div className="bg-mist-60/20 rounded p-3 mb-2">
177
+
<p className="text-xs text-mist-80 mb-1">(string "Type")</p>
178
+
<p className="text-xs text-mist-100 mb-2">(string blob.mimetype)</p>
179
+
<p className="text-xs text-mist-80 mb-1">(string "Size")</p>
180
+
<p className="text-xs text-mist-100 mb-2">(string blob.size)</p>
181
+
<p className="text-xs text-mist-80 mb-1">(string "CID")</p>
182
+
<p className="font-mono text-xs text-mist-100 break-all">
183
+
(string blob.cid)
184
+
</p>
185
+
</div>
186
+
<p className="text-xs text-phoenix-100">
187
+
(string "This action cannot be undone and may break references to this blob.")
188
+
</p>
189
+
<div className="flex gap-3 mt-2">
190
+
<Button kind=`Danger formMethod="post" type_="submit">(string "delete")</Button>
191
+
<Button
192
+
kind=`Tertiary
193
+
onClick=(fun _ -> setDeleteConfirmFor (fun _ -> None))>
194
+
(string "cancel")
195
+
</Button>
196
+
</div>
197
+
</form>
198
+
| None -> null )
199
+
</Aria.Dialog>
200
+
</Aria.Modal>
201
+
</Aria.ModalOverlay>
202
+
</Aria.DialogTrigger> )]
203
+
</ClientOnly>
204
+
</main>
205
+
</div>
+1
-5
frontend/src/templates/AdminInvitesPage.mlx
+1
-5
frontend/src/templates/AdminInvitesPage.mlx
···
16
16
; success: string option [@default None] }
17
17
[@@deriving json]
18
18
19
-
let admin_pages =
20
-
[ ("Users", "/admin/users")
21
-
; ("Invite codes", "/admin/invites") ]
22
-
23
19
let[@react.component] make
24
20
~props:
25
21
({ invites
···
39
35
(* delete confirmation state *)
40
36
let deleteConfirmFor, setDeleteConfirmFor = useState (fun () -> (None : invite option)) in
41
37
<div className="w-full h-full max-w-4xl px-4 pt-16 mx-auto flex flex-col md:flex-row gap-12">
42
-
<Sidebar pages=admin_pages active_page="/admin/invites" />
38
+
<AdminSidebar active_page="/admin/invites" />
43
39
<main className="flex-1 w-full">
44
40
<h1 className="text-2xl font-serif text-mana-200 mb-1">
45
41
(string "invite codes")
+1
-5
frontend/src/templates/AdminUsersPage.mlx
+1
-5
frontend/src/templates/AdminUsersPage.mlx
···
35
35
false
36
36
with Exit -> true
37
37
38
-
let admin_pages =
39
-
[ ("Users", "/admin/users")
40
-
; ("Invite codes", "/admin/invites") ]
41
-
42
38
let[@react.component] make
43
39
~props:
44
40
({ actors
···
63
59
(* delete confirmation state *)
64
60
let deleteConfirmFor, setDeleteConfirmFor = useState (fun () -> (None : actor option)) in
65
61
<div className="w-full h-full max-w-4xl px-4 pt-16 mx-auto flex flex-col md:flex-row gap-12">
66
-
<Sidebar pages=admin_pages active_page="/admin/users" />
62
+
<AdminSidebar active_page="/admin/users" />
67
63
<main className="flex-1 w-full">
68
64
<h1 className="text-2xl font-serif text-mana-200 mb-1">
69
65
(string "users")
+205
pegasus/lib/api/admin_/blobs.ml
+205
pegasus/lib/api/admin_/blobs.ml
···
1
+
let format_size bytes =
2
+
if bytes < 1024 then Printf.sprintf "%d B" bytes
3
+
else if bytes < 1024 * 1024 then
4
+
Printf.sprintf "%.1f KB" (float_of_int bytes /. 1024.0)
5
+
else if bytes < 1024 * 1024 * 1024 then
6
+
Printf.sprintf "%.1f MB" (float_of_int bytes /. 1024.0 /. 1024.0)
7
+
else
8
+
Printf.sprintf "%.1f GB" (float_of_int bytes /. 1024.0 /. 1024.0 /. 1024.0)
9
+
10
+
let format_date timestamp_ms =
11
+
let ts = float_of_int timestamp_ms /. 1000.0 in
12
+
let dt = Timedesc.of_timestamp_float_s_exn ts in
13
+
Format.asprintf "%a"
14
+
(Timedesc.pp
15
+
~format:"{year}-{mon:0X}-{day:0X}, {12hour:0X}:{min:0X} {am/pm:XX}" () )
16
+
dt
17
+
18
+
let get_blob_size ~did ~cid ~storage : int Lwt.t =
19
+
match%lwt Blob_store.get ~did ~cid ~storage with
20
+
| Some data ->
21
+
Lwt.return (Bytes.length data)
22
+
| None ->
23
+
Lwt.return 0
24
+
25
+
let list_all_blobs ~limit ~cursor db =
26
+
let%lwt actors = Data_store.list_actors ~limit:1000 db in
27
+
let%lwt all_blobs =
28
+
Lwt_list.fold_left_s
29
+
(fun acc (actor : Data_store.Types.actor) ->
30
+
try%lwt
31
+
let%lwt user_db = User_store.connect actor.did in
32
+
let%lwt blobs = User_store.list_blobs user_db ~limit:100 ~cursor:"" in
33
+
let%lwt blob_metadata =
34
+
Lwt_list.map_s
35
+
(fun cid ->
36
+
let%lwt blob_opt = User_store.get_blob_metadata user_db cid in
37
+
match blob_opt with
38
+
| Some blob ->
39
+
let%lwt size =
40
+
get_blob_size ~did:actor.did ~cid ~storage:blob.storage
41
+
in
42
+
Lwt.return
43
+
(Some
44
+
( actor.did
45
+
, actor.handle
46
+
, actor.created_at
47
+
, cid
48
+
, blob.mimetype
49
+
, blob.storage
50
+
, size ) )
51
+
| None ->
52
+
Lwt.return None )
53
+
blobs
54
+
in
55
+
let filtered_blobs = List.filter_map (fun x -> x) blob_metadata in
56
+
Lwt.return (acc @ filtered_blobs)
57
+
with _ -> Lwt.return acc )
58
+
[] actors
59
+
in
60
+
let sorted_blobs =
61
+
List.sort
62
+
(fun (did1, _, _, cid1, _, _, _) (did2, _, _, cid2, _, _, _) ->
63
+
let did_cmp = String.compare did1 did2 in
64
+
if did_cmp <> 0 then did_cmp else Cid.compare cid1 cid2 )
65
+
all_blobs
66
+
in
67
+
let filtered =
68
+
if cursor = "" then sorted_blobs
69
+
else
70
+
List.filter
71
+
(fun (did, _, _, cid, _, _, _) ->
72
+
let key = did ^ ":" ^ Cid.to_string cid in
73
+
key > cursor )
74
+
sorted_blobs
75
+
in
76
+
(* take limit + 1 for pagination *)
77
+
let page =
78
+
if List.length filtered > limit then
79
+
List.filteri (fun i _ -> i < limit) filtered
80
+
else filtered
81
+
in
82
+
let has_more = List.length filtered > limit in
83
+
let next_cursor =
84
+
if has_more then
85
+
match List.rev page with
86
+
| (did, _, _, cid, _, _, _) :: _ ->
87
+
Some (did ^ ":" ^ Cid.to_string cid)
88
+
| [] ->
89
+
None
90
+
else None
91
+
in
92
+
Lwt.return (page, next_cursor)
93
+
94
+
let blob_to_view (did, handle, created_at, cid, mimetype, storage, size) :
95
+
Frontend.AdminBlobsPage.blob =
96
+
{ did
97
+
; handle
98
+
; user_created_at= format_date created_at
99
+
; cid= Cid.to_string cid
100
+
; mimetype
101
+
; storage= Blob_store.storage_to_string storage
102
+
; size= format_size size }
103
+
104
+
let get_handler =
105
+
Xrpc.handler (fun ctx ->
106
+
match%lwt Session.is_admin_authenticated ctx.req with
107
+
| false ->
108
+
Dream.redirect ctx.req "/admin/login"
109
+
| true ->
110
+
let cursor =
111
+
Dream.query ctx.req "cursor" |> Option.value ~default:""
112
+
in
113
+
let limit = 50 in
114
+
let%lwt blobs, next_cursor = list_all_blobs ~limit ~cursor ctx.db in
115
+
let blobs = List.map blob_to_view blobs in
116
+
let csrf_token = Dream.csrf_token ctx.req in
117
+
Util.render_html ~title:"Admin / Blobs"
118
+
(module Frontend.AdminBlobsPage)
119
+
~props:
120
+
{ blobs
121
+
; csrf_token
122
+
; cursor
123
+
; next_cursor
124
+
; error= None
125
+
; success= None } )
126
+
127
+
let view_handler =
128
+
Xrpc.handler (fun ctx ->
129
+
match%lwt Session.is_admin_authenticated ctx.req with
130
+
| false ->
131
+
Dream.redirect ctx.req "/admin/login"
132
+
| true -> (
133
+
let did = Dream.query ctx.req "did" |> Option.value ~default:"" in
134
+
let cid_str = Dream.query ctx.req "cid" |> Option.value ~default:"" in
135
+
let download = Dream.query ctx.req "download" |> Option.is_some in
136
+
match Cid.of_string cid_str with
137
+
| Ok cid -> (
138
+
try%lwt
139
+
let%lwt user_db = User_store.connect did in
140
+
match%lwt User_store.get_blob user_db cid with
141
+
| Some blob ->
142
+
let content_disposition =
143
+
if download then
144
+
"attachment; filename=\"" ^ Cid.to_string cid ^ "\""
145
+
else "inline"
146
+
in
147
+
Dream.respond
148
+
~headers:
149
+
[ ("Content-Type", blob.mimetype)
150
+
; ("Content-Disposition", content_disposition)
151
+
; ("Cache-Control", "public, max-age=31536000") ]
152
+
(Bytes.to_string blob.data)
153
+
| None ->
154
+
Dream.respond ~status:`Not_Found "Blob not found"
155
+
with e ->
156
+
Dream.respond ~status:`Internal_Server_Error
157
+
("Error: " ^ Printexc.to_string e) )
158
+
| Error _ ->
159
+
Dream.respond ~status:`Bad_Request "Invalid CID" ) )
160
+
161
+
let post_handler =
162
+
Xrpc.handler (fun ctx ->
163
+
match%lwt Session.is_admin_authenticated ctx.req with
164
+
| false ->
165
+
Dream.redirect ctx.req "/admin/login"
166
+
| true -> (
167
+
let csrf_token = Dream.csrf_token ctx.req in
168
+
let render_page ?error ?success () =
169
+
let cursor =
170
+
Dream.query ctx.req "cursor" |> Option.value ~default:""
171
+
in
172
+
let limit = 50 in
173
+
let%lwt blobs, next_cursor = list_all_blobs ~limit ~cursor ctx.db in
174
+
let blobs = List.map blob_to_view blobs in
175
+
Util.render_html ~title:"Admin / Blobs"
176
+
(module Frontend.AdminBlobsPage)
177
+
~props:{blobs; csrf_token; cursor; next_cursor; error; success}
178
+
in
179
+
match%lwt Dream.form ctx.req with
180
+
| `Ok fields -> (
181
+
let action = List.assoc_opt "action" fields in
182
+
let did =
183
+
List.assoc_opt "did" fields |> Option.value ~default:""
184
+
in
185
+
let cid_str =
186
+
List.assoc_opt "cid" fields |> Option.value ~default:""
187
+
in
188
+
match action with
189
+
| Some "delete_blob" -> (
190
+
match Cid.of_string cid_str with
191
+
| Ok cid -> (
192
+
try%lwt
193
+
let%lwt user_db = User_store.connect did in
194
+
let%lwt () = User_store.delete_blob user_db cid in
195
+
render_page ~success:"Blob deleted successfully." ()
196
+
with e ->
197
+
render_page
198
+
~error:("Failed to delete blob: " ^ Printexc.to_string e)
199
+
() )
200
+
| Error _ ->
201
+
render_page ~error:"Invalid blob CID." () )
202
+
| _ ->
203
+
render_page ~error:"Invalid action." () )
204
+
| _ ->
205
+
render_page ~error:"Invalid form submission." () ) )