objective categorical abstract machine language personal data server
futur.blue
1open Pegasus
2open Dream
3
4let () =
5 Rate_limiter.Shared.register ~name:"repo-write-hour" ~duration_ms:Util.hour
6 ~points:5000 ;
7 Rate_limiter.Shared.register ~name:"repo-write-day" ~duration_ms:Util.day
8 ~points:35000
9
10let handlers =
11 [ (* meta *)
12 (get, "/", Api.Root.handler)
13 ; (get, "/robots.txt", Api.Robots.handler)
14 ; (get, "/xrpc/_health", Api.Health.handler)
15 ; (get, "/.well-known/did.json", Api.Well_known.did_json)
16 ; ( get
17 , "/.well-known/oauth-protected-resource"
18 , Api.Well_known.oauth_protected_resource )
19 ; ( get
20 , "/.well-known/oauth-authorization-server"
21 , Api.Well_known.oauth_authorization_server )
22 ; (get, "/.well-known/atproto-did", Api.Well_known.atproto_did)
23 ; (options, "/xrpc/**", Xrpc.handler (fun _ -> Dream.empty `No_Content))
24 ; (* oauth *)
25 (options, "/oauth/par", Xrpc.handler (fun _ -> Dream.empty `No_Content))
26 ; (post, "/oauth/par", Api.Oauth_.Par.post_handler)
27 ; (get, "/oauth/authorize", Api.Oauth_.Authorize.get_handler)
28 ; (post, "/oauth/authorize", Api.Oauth_.Authorize.post_handler)
29 ; (options, "/oauth/token", Xrpc.handler (fun _ -> Dream.empty `No_Content))
30 ; (post, "/oauth/token", Api.Oauth_.Token.post_handler)
31 ; (* account ui *)
32 (get, "/account", Api.Account_.Index.get_handler)
33 ; (post, "/account", Api.Account_.Index.post_handler)
34 ; (get, "/account/security", Api.Account_.Security.Index.get_handler)
35 ; (post, "/account/security", Api.Account_.Security.Index.post_handler)
36 ; ( get
37 , "/account/security/backup-codes"
38 , Api.Account_.Security.Backup_codes.count_handler )
39 ; ( post
40 , "/account/security/backup-codes/regenerate"
41 , Api.Account_.Security.Backup_codes.regenerate_handler )
42 ; ( get
43 , "/account/security/totp/setup"
44 , Api.Account_.Security.Totp.setup_handler )
45 ; ( post
46 , "/account/security/totp/verify"
47 , Api.Account_.Security.Totp.verify_handler )
48 ; ( post
49 , "/account/security/totp/disable"
50 , Api.Account_.Security.Totp.disable_handler )
51 ; ( get
52 , "/account/security/keys"
53 , Api.Account_.Security.Security_key.list_handler )
54 ; ( post
55 , "/account/security/keys/setup"
56 , Api.Account_.Security.Security_key.setup_handler )
57 ; ( post
58 , "/account/security/keys/:id/verify"
59 , Api.Account_.Security.Security_key.verify_handler )
60 ; ( post
61 , "/account/security/keys/:id/resync"
62 , Api.Account_.Security.Security_key.resync_handler )
63 ; ( delete
64 , "/account/security/keys/:id"
65 , Api.Account_.Security.Security_key.delete_handler )
66 ; (get, "/account/permissions", Api.Account_.Permissions.get_handler)
67 ; (post, "/account/permissions", Api.Account_.Permissions.post_handler)
68 ; (get, "/account/identity", Api.Account_.Identity.get_handler)
69 ; (post, "/account/identity", Api.Account_.Identity.post_handler)
70 ; (get, "/account/login", Api.Account_.Login.get_handler)
71 ; (post, "/account/login", Api.Account_.Login.post_handler)
72 ; (get, "/account/signup", Api.Account_.Signup.get_handler)
73 ; (post, "/account/signup", Api.Account_.Signup.post_handler)
74 ; ( get
75 , "/account/signup/check-handle"
76 , Api.Account_.Signup.check_handle_handler )
77 ; (get, "/account/migrate", Api.Account_.Migrate.get_handler)
78 ; (post, "/account/migrate", Api.Account_.Migrate.post_handler)
79 ; (post, "/account/switch", Api.Account_.Login.switch_account_handler)
80 ; (get, "/account/logout", Api.Account_.Logout.handler)
81 ; (get, "/account/reset", Api.Account_.Password_reset.get_handler)
82 ; (post, "/account/reset", Api.Account_.Password_reset.post_handler)
83 ; (* passkey management (authed) *)
84 (get, "/account/passkeys", Api.Account_.Passkeys.list_handler)
85 ; ( get
86 , "/account/passkeys/register/options"
87 , Api.Account_.Passkeys.register_options_handler )
88 ; ( post
89 , "/account/passkeys/register/verify"
90 , Api.Account_.Passkeys.register_verify_handler )
91 ; (delete, "/account/passkeys/:id", Api.Account_.Passkeys.delete_handler)
92 ; (post, "/account/passkeys/:id/rename", Api.Account_.Passkeys.rename_handler)
93 ; (* passkey login (unauthed) *)
94 ( get
95 , "/account/passkeys/login/options"
96 , Api.Account_.Passkeys.login_options_handler )
97 ; ( post
98 , "/account/passkeys/login/verify"
99 , Api.Account_.Passkeys.login_verify_handler )
100 ; (* admin ui *)
101 (get, "/admin", Api.Admin_.Index.handler)
102 ; (get, "/admin/login", Api.Admin_.Login.get_handler)
103 ; (post, "/admin/login", Api.Admin_.Login.post_handler)
104 ; (get, "/admin/users", Api.Admin_.Users.get_handler)
105 ; (post, "/admin/users", Api.Admin_.Users.post_handler)
106 ; (get, "/admin/invites", Api.Admin_.Invites.get_handler)
107 ; (post, "/admin/invites", Api.Admin_.Invites.post_handler)
108 ; (get, "/admin/blobs", Api.Admin_.Blobs.get_handler)
109 ; (post, "/admin/blobs", Api.Admin_.Blobs.post_handler)
110 ; (get, "/admin/blobs/view", Api.Admin_.Blobs.view_handler)
111 ; (* unauthed *)
112 ( get
113 , "/xrpc/com.atproto.server.describeServer"
114 , Api.Server.DescribeServer.handler )
115 ; (get, "/xrpc/com.atproto.repo.describeRepo", Api.Repo.DescribeRepo.handler)
116 ; ( get
117 , "/xrpc/com.atproto.identity.resolveHandle"
118 , Api.Identity.ResolveHandle.handler )
119 ; (* admin *)
120 ( post
121 , "/xrpc/com.atproto.admin.deleteAccount"
122 , Api.Admin.DeleteAccount.handler )
123 ; ( get
124 , "/xrpc/com.atproto.admin.getAccountInfo"
125 , Api.Admin.GetAccountInfo.handler )
126 ; ( get
127 , "/xrpc/com.atproto.admin.getAccountInfos"
128 , Api.Admin.GetAccountInfos.handler )
129 ; ( get
130 , "/xrpc/com.atproto.admin.getInviteCodes"
131 , Api.Admin.GetInviteCodes.handler )
132 ; (post, "/xrpc/com.atproto.admin.sendEmail", Api.Admin.SendEmail.handler)
133 ; ( post
134 , "/xrpc/com.atproto.admin.updateAccountEmail"
135 , Api.Admin.UpdateAccountEmail.handler )
136 ; ( post
137 , "/xrpc/com.atproto.admin.updateAccountHandle"
138 , Api.Admin.UpdateAccountHandle.handler )
139 ; (* account management *)
140 ( post
141 , "/xrpc/com.atproto.server.createInviteCode"
142 , Api.Server.CreateInviteCode.handler )
143 ; ( post
144 , "/xrpc/com.atproto.server.createInviteCodes"
145 , Api.Server.CreateInviteCodes.handler )
146 ; ( post
147 , "/xrpc/com.atproto.server.createAccount"
148 , Api.Server.CreateAccount.handler )
149 ; ( post
150 , "/xrpc/com.atproto.server.createSession"
151 , Api.Server.CreateSession.handler )
152 ; (get, "/xrpc/com.atproto.server.getSession", Api.Server.GetSession.handler)
153 ; ( post
154 , "/xrpc/com.atproto.server.refreshSession"
155 , Api.Server.RefreshSession.handler )
156 ; ( post
157 , "/xrpc/com.atproto.server.deleteSession"
158 , Api.Server.DeleteSession.handler )
159 ; ( get
160 , "/xrpc/com.atproto.server.getServiceAuth"
161 , Api.Server.GetServiceAuth.handler )
162 ; ( get
163 , "/xrpc/com.atproto.server.checkAccountStatus"
164 , Api.Server.CheckAccountStatus.handler )
165 ; ( post
166 , "/xrpc/com.atproto.server.activateAccount"
167 , Api.Server.ActivateAccount.handler )
168 ; ( post
169 , "/xrpc/com.atproto.server.requestEmailConfirmation"
170 , Api.Server.RequestEmailConfirmation.handler )
171 ; ( post
172 , "/xrpc/com.atproto.server.requestEmailUpdate"
173 , Api.Server.RequestEmailUpdate.handler )
174 ; ( post
175 , "/xrpc/com.atproto.server.confirmEmail"
176 , Api.Server.ConfirmEmail.handler )
177 ; ( post
178 , "/xrpc/com.atproto.server.requestPasswordReset"
179 , Api.Server.RequestPasswordReset.handler )
180 ; ( post
181 , "/xrpc/com.atproto.server.resetPassword"
182 , Api.Server.ResetPassword.handler )
183 ; ( post
184 , "/xrpc/com.atproto.server.reserveSigningKey"
185 , Api.Server.ReserveSigningKey.handler )
186 ; ( post
187 , "/xrpc/com.atproto.server.requestAccountDelete"
188 , Api.Server.RequestAccountDelete.handler )
189 ; ( post
190 , "/xrpc/com.atproto.server.deleteAccount"
191 , Api.Server.DeleteAccount.handler )
192 ; ( post
193 , "/xrpc/com.atproto.server.deactivateAccount"
194 , Api.Server.DeactivateAccount.handler )
195 ; ( get
196 , "/xrpc/com.atproto.repo.listMissingBlobs"
197 , Api.Repo.ListMissingBlobs.handler )
198 ; ( post
199 , "/xrpc/com.atproto.identity.updateHandle"
200 , Api.Identity.UpdateHandle.handler )
201 ; ( post
202 , "/xrpc/com.atproto.server.updateEmail"
203 , Api.Server.UpdateEmail.handler )
204 ; (* plc *)
205 ( get
206 , "/xrpc/com.atproto.identity.getRecommendedDidCredentials"
207 , Api.Identity.GetRecommendedDidCredentials.handler )
208 ; ( post
209 , "/xrpc/com.atproto.identity.requestPlcOperationSignature"
210 , Api.Identity.RequestPlcOperationSignature.handler )
211 ; ( post
212 , "/xrpc/com.atproto.identity.signPlcOperation"
213 , Api.Identity.SignPlcOperation.handler )
214 ; ( post
215 , "/xrpc/com.atproto.identity.submitPlcOperation"
216 , Api.Identity.SubmitPlcOperation.handler )
217 ; (* repo *)
218 (post, "/xrpc/com.atproto.repo.applyWrites", Api.Repo.ApplyWrites.handler)
219 ; (post, "/xrpc/com.atproto.repo.createRecord", Api.Repo.CreateRecord.handler)
220 ; (post, "/xrpc/com.atproto.repo.putRecord", Api.Repo.PutRecord.handler)
221 ; (get, "/xrpc/com.atproto.repo.getRecord", Api.Repo.GetRecord.handler)
222 ; (get, "/xrpc/com.atproto.repo.listRecords", Api.Repo.ListRecords.handler)
223 ; (post, "/xrpc/com.atproto.repo.deleteRecord", Api.Repo.DeleteRecord.handler)
224 ; (post, "/xrpc/com.atproto.repo.uploadBlob", Api.Repo.UploadBlob.handler)
225 ; (post, "/xrpc/com.atproto.repo.importRepo", Api.Repo.ImportRepo.handler)
226 ; (* sync *)
227 (get, "/xrpc/com.atproto.sync.getRepo", Api.Sync.GetRepo.handler)
228 ; (get, "/xrpc/com.atproto.sync.getRepoStatus", Api.Sync.GetRepoStatus.handler)
229 ; ( get
230 , "/xrpc/com.atproto.sync.getLatestCommit"
231 , Api.Sync.GetLatestCommit.handler )
232 ; (get, "/xrpc/com.atproto.sync.listRepos", Api.Sync.ListRepos.handler)
233 ; (get, "/xrpc/com.atproto.sync.getRecord", Api.Sync.GetRecord.handler)
234 ; (get, "/xrpc/com.atproto.sync.getBlocks", Api.Sync.GetBlocks.handler)
235 ; (get, "/xrpc/com.atproto.sync.getBlob", Api.Sync.GetBlob.handler)
236 ; (get, "/xrpc/com.atproto.sync.listBlobs", Api.Sync.ListBlobs.handler)
237 ; ( get
238 , "/xrpc/com.atproto.sync.subscribeRepos"
239 , Api.Sync.SubscribeRepos.handler )
240 ; (* misc *)
241 ( get
242 , "/xrpc/app.bsky.actor.getPreferences"
243 , Api.Proxy.AppBskyActorGetPreferences.handler )
244 ; ( post
245 , "/xrpc/app.bsky.actor.putPreferences"
246 , Api.Proxy.AppBskyActorPutPreferences.handler )
247 ; (get, "/xrpc/app.bsky.feed.getFeed", Api.Proxy.AppBskyFeedGetFeed.handler)
248 ]
249
250let public_loader _root path _request =
251 match Public.read path with
252 | None ->
253 Dream.empty `Not_Found
254 | Some asset ->
255 Dream.respond
256 ~headers:[("Cache-Control", "public, max-age=31536000")]
257 asset
258
259let static_routes =
260 [Dream.get "/public/**" (Dream.static ~loader:public_loader "")]
261
262let serve () =
263 Printexc.record_backtrace true ;
264 Printexc.register_printer Errors.printer ;
265 Dream.initialize_log ~level:Env.log_level () ;
266 List.iter (fun src ->
267 match Logs.Src.name src with
268 (* useless noise on debug level *)
269 | "cohttp.lwt.io" | "cohttp.lwt.server" | "tls.tracing" | "tls.config" ->
270 Logs.Src.set_level src None
271 | _ ->
272 () )
273 @@ Logs.Src.list () ;
274 let%lwt db = Data_store.connect ~create:true () in
275 S3.Backup.start () ;
276 Dream.serve ~interface:"0.0.0.0" ~port:8008
277 @@ Dream.pipeline
278 [ Dream.logger
279 ; Dream.set_secret (Env.jwt_key |> Kleidos.privkey_to_multikey)
280 ; Dream.cookie_sessions
281 ; Xrpc.dpop_middleware
282 ; Xrpc.cors_middleware ]
283 @@ Dream.router
284 @@ List.map
285 (fun (fn, path, handler) ->
286 fn path (fun req -> handler ({req; db} : Xrpc.init)) )
287 handlers
288 @ static_routes
289 @ [ Dream.get "/xrpc/**" (Xrpc.service_proxy_handler db)
290 ; Dream.post "/xrpc/**" (Xrpc.service_proxy_handler db) ]
291
292let create_invite ?(uses = 1) () =
293 let%lwt db = Data_store.connect ~create:true () in
294 let%lwt code =
295 Api.Server.CreateInviteCode.create_invite_code ~db ~did:"admin"
296 ~use_count:uses
297 in
298 print_endline
299 ("invite code created with " ^ string_of_int uses ^ " use(s): " ^ code)
300 |> Lwt.return
301
302let migrate_blobs ?did () =
303 match did with
304 | Some did ->
305 print_endline ("migrating blobs for user " ^ did) ;
306 let%lwt _ = S3.Blob_migration.migrate_user ~did in
307 Lwt.return_unit
308 | None ->
309 print_endline "migrating all blobs to S3" ;
310 S3.Blob_migration.migrate_all ()
311
312let rebuild_mst ~did () =
313 print_endline ("rebuilding MST for " ^ did) ;
314 let%lwt repo = Repository.load did in
315 match%lwt Repository.rebuild_mst repo with
316 | Ok (commit_cid, commit) ->
317 print_endline
318 (Printf.sprintf "MST rebuilt successfully, new commit: %s (rev: %s)"
319 (Cid.to_string commit_cid) commit.rev ) ;
320 Lwt.return_unit
321 | Error exn ->
322 print_endline ("error rebuilding MST: " ^ Printexc.to_string exn) ;
323 exit 1
324
325let print_usage () =
326 print_endline
327 @@ String.trim
328 {|
329usage: pegasus [command]
330
331commands:
332 serve start the PDS
333 create-invite [uses] create an invite code with an optional number of uses (default: 1)
334 migrate-blobs migrate all local blobs to S3
335 migrate-blobs <did> migrate blobs for a specific user to S3
336 rebuild-mst <did> rebuild MST from records table (recovery tool)
337
338see also: gen-keys
339|}
340
341let () =
342 let args = Array.to_list Sys.argv |> List.tl in
343 match args with
344 | [] | ["serve"] ->
345 Lwt_main.run (serve ())
346 | ["create-invite"] ->
347 Lwt_main.run (create_invite ())
348 | ["create-invite"; uses] ->
349 let uses = int_of_string uses in
350 Lwt_main.run (create_invite ~uses ())
351 | ["migrate-blobs"] ->
352 Lwt_main.run (migrate_blobs ())
353 | ["migrate-blobs"; did] ->
354 Lwt_main.run (migrate_blobs ~did ())
355 | ["rebuild-mst"; did] ->
356 Lwt_main.run (rebuild_mst ~did ())
357 | ["help"] | ["--help"] | ["-h"] ->
358 print_usage ()
359 | cmd :: _ ->
360 print_endline ("unknown command: " ^ cmd) ;
361 print_usage () ;
362 exit 1