objective categorical abstract machine language personal data server

Admin blobs page

futur.blue 7aab9464 5b6f6e7a

verified
+429 -11
+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
··· 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
··· 1 + [@@@ocaml.warning "-26-27"] 2 + 3 + let pages = 4 + [ ("Users", "/admin/users") 5 + ; ("Invite codes", "/admin/invites") 6 + ; ("Blobs", "/admin/blobs") ] 7 + 8 + let[@react.component] make ~active_page () = 9 + <Sidebar 10 + pages 11 + active_page 12 + />
+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
··· 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
··· 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
··· 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." () ) )