forked from
futur.blue/pegasus
objective categorical abstract machine language personal data server
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/permissions", Api.Account_.Permissions.get_handler)
35 ; (post, "/account/permissions", Api.Account_.Permissions.post_handler)
36 ; (get, "/account/identity", Api.Account_.Identity.get_handler)
37 ; (post, "/account/identity", Api.Account_.Identity.post_handler)
38 ; (get, "/account/login", Api.Account_.Login.get_handler)
39 ; (post, "/account/login", Api.Account_.Login.post_handler)
40 ; (get, "/account/signup", Api.Account_.Signup.get_handler)
41 ; (post, "/account/signup", Api.Account_.Signup.post_handler)
42 ; ( get
43 , "/account/signup/check-handle"
44 , Api.Account_.Signup.check_handle_handler )
45 ; (get, "/account/migrate", Api.Account_.Migrate.get_handler)
46 ; (post, "/account/migrate", Api.Account_.Migrate.post_handler)
47 ; (post, "/account/switch", Api.Account_.Login.switch_account_handler)
48 ; (get, "/account/logout", Api.Account_.Logout.handler)
49 ; (* admin ui *)
50 (get, "/admin", Api.Admin_.Index.handler)
51 ; (get, "/admin/login", Api.Admin_.Login.get_handler)
52 ; (post, "/admin/login", Api.Admin_.Login.post_handler)
53 ; (get, "/admin/users", Api.Admin_.Users.get_handler)
54 ; (post, "/admin/users", Api.Admin_.Users.post_handler)
55 ; (get, "/admin/invites", Api.Admin_.Invites.get_handler)
56 ; (post, "/admin/invites", Api.Admin_.Invites.post_handler)
57 ; (get, "/admin/blobs", Api.Admin_.Blobs.get_handler)
58 ; (post, "/admin/blobs", Api.Admin_.Blobs.post_handler)
59 ; (get, "/admin/blobs/view", Api.Admin_.Blobs.view_handler)
60 ; (* unauthed *)
61 ( get
62 , "/xrpc/com.atproto.server.describeServer"
63 , Api.Server.DescribeServer.handler )
64 ; (get, "/xrpc/com.atproto.repo.describeRepo", Api.Repo.DescribeRepo.handler)
65 ; ( get
66 , "/xrpc/com.atproto.identity.resolveHandle"
67 , Api.Identity.ResolveHandle.handler )
68 ; (* admin *)
69 ( post
70 , "/xrpc/com.atproto.admin.deleteAccount"
71 , Api.Admin.DeleteAccount.handler )
72 ; ( get
73 , "/xrpc/com.atproto.admin.getAccountInfo"
74 , Api.Admin.GetAccountInfo.handler )
75 ; ( get
76 , "/xrpc/com.atproto.admin.getAccountInfos"
77 , Api.Admin.GetAccountInfos.handler )
78 ; ( get
79 , "/xrpc/com.atproto.admin.getInviteCodes"
80 , Api.Admin.GetInviteCodes.handler )
81 ; (post, "/xrpc/com.atproto.admin.sendEmail", Api.Admin.SendEmail.handler)
82 ; ( post
83 , "/xrpc/com.atproto.admin.updateAccountEmail"
84 , Api.Admin.UpdateAccountEmail.handler )
85 ; ( post
86 , "/xrpc/com.atproto.admin.updateAccountHandle"
87 , Api.Admin.UpdateAccountHandle.handler )
88 ; (* account management *)
89 ( post
90 , "/xrpc/com.atproto.server.createInviteCode"
91 , Api.Server.CreateInviteCode.handler )
92 ; ( post
93 , "/xrpc/com.atproto.server.createInviteCodes"
94 , Api.Server.CreateInviteCodes.handler )
95 ; ( post
96 , "/xrpc/com.atproto.server.createAccount"
97 , Api.Server.CreateAccount.handler )
98 ; ( post
99 , "/xrpc/com.atproto.server.createSession"
100 , Api.Server.CreateSession.handler )
101 ; (get, "/xrpc/com.atproto.server.getSession", Api.Server.GetSession.handler)
102 ; ( post
103 , "/xrpc/com.atproto.server.refreshSession"
104 , Api.Server.RefreshSession.handler )
105 ; ( post
106 , "/xrpc/com.atproto.server.deleteSession"
107 , Api.Server.DeleteSession.handler )
108 ; ( get
109 , "/xrpc/com.atproto.server.getServiceAuth"
110 , Api.Server.GetServiceAuth.handler )
111 ; ( get
112 , "/xrpc/com.atproto.server.checkAccountStatus"
113 , Api.Server.CheckAccountStatus.handler )
114 ; ( post
115 , "/xrpc/com.atproto.server.activateAccount"
116 , Api.Server.ActivateAccount.handler )
117 ; ( post
118 , "/xrpc/com.atproto.server.requestEmailConfirmation"
119 , Api.Server.RequestEmailConfirmation.handler )
120 ; ( post
121 , "/xrpc/com.atproto.server.requestEmailUpdate"
122 , Api.Server.RequestEmailUpdate.handler )
123 ; ( post
124 , "/xrpc/com.atproto.server.confirmEmail"
125 , Api.Server.ConfirmEmail.handler )
126 ; ( post
127 , "/xrpc/com.atproto.server.requestPasswordReset"
128 , Api.Server.RequestPasswordReset.handler )
129 ; ( post
130 , "/xrpc/com.atproto.server.resetPassword"
131 , Api.Server.ResetPassword.handler )
132 ; ( post
133 , "/xrpc/com.atproto.server.reserveSigningKey"
134 , Api.Server.ReserveSigningKey.handler )
135 ; ( post
136 , "/xrpc/com.atproto.server.requestAccountDelete"
137 , Api.Server.RequestAccountDelete.handler )
138 ; ( post
139 , "/xrpc/com.atproto.server.deleteAccount"
140 , Api.Server.DeleteAccount.handler )
141 ; ( post
142 , "/xrpc/com.atproto.server.deactivateAccount"
143 , Api.Server.DeactivateAccount.handler )
144 ; ( get
145 , "/xrpc/com.atproto.repo.listMissingBlobs"
146 , Api.Repo.ListMissingBlobs.handler )
147 ; ( post
148 , "/xrpc/com.atproto.identity.updateHandle"
149 , Api.Identity.UpdateHandle.handler )
150 ; ( post
151 , "/xrpc/com.atproto.server.updateEmail"
152 , Api.Server.UpdateEmail.handler )
153 ; (* plc *)
154 ( get
155 , "/xrpc/com.atproto.identity.getRecommendedDidCredentials"
156 , Api.Identity.GetRecommendedDidCredentials.handler )
157 ; ( post
158 , "/xrpc/com.atproto.identity.requestPlcOperationSignature"
159 , Api.Identity.RequestPlcOperationSignature.handler )
160 ; ( post
161 , "/xrpc/com.atproto.identity.signPlcOperation"
162 , Api.Identity.SignPlcOperation.handler )
163 ; ( post
164 , "/xrpc/com.atproto.identity.submitPlcOperation"
165 , Api.Identity.SubmitPlcOperation.handler )
166 ; (* repo *)
167 (post, "/xrpc/com.atproto.repo.applyWrites", Api.Repo.ApplyWrites.handler)
168 ; (post, "/xrpc/com.atproto.repo.createRecord", Api.Repo.CreateRecord.handler)
169 ; (post, "/xrpc/com.atproto.repo.putRecord", Api.Repo.PutRecord.handler)
170 ; (get, "/xrpc/com.atproto.repo.getRecord", Api.Repo.GetRecord.handler)
171 ; (get, "/xrpc/com.atproto.repo.listRecords", Api.Repo.ListRecords.handler)
172 ; (post, "/xrpc/com.atproto.repo.deleteRecord", Api.Repo.DeleteRecord.handler)
173 ; (post, "/xrpc/com.atproto.repo.uploadBlob", Api.Repo.UploadBlob.handler)
174 ; (post, "/xrpc/com.atproto.repo.importRepo", Api.Repo.ImportRepo.handler)
175 ; (* sync *)
176 (get, "/xrpc/com.atproto.sync.getRepo", Api.Sync.GetRepo.handler)
177 ; (get, "/xrpc/com.atproto.sync.getRepoStatus", Api.Sync.GetRepoStatus.handler)
178 ; ( get
179 , "/xrpc/com.atproto.sync.getLatestCommit"
180 , Api.Sync.GetLatestCommit.handler )
181 ; (get, "/xrpc/com.atproto.sync.listRepos", Api.Sync.ListRepos.handler)
182 ; (get, "/xrpc/com.atproto.sync.getRecord", Api.Sync.GetRecord.handler)
183 ; (get, "/xrpc/com.atproto.sync.getBlocks", Api.Sync.GetBlocks.handler)
184 ; (get, "/xrpc/com.atproto.sync.getBlob", Api.Sync.GetBlob.handler)
185 ; (get, "/xrpc/com.atproto.sync.listBlobs", Api.Sync.ListBlobs.handler)
186 ; ( get
187 , "/xrpc/com.atproto.sync.subscribeRepos"
188 , Api.Sync.SubscribeRepos.handler )
189 ; (* misc *)
190 ( get
191 , "/xrpc/app.bsky.actor.getPreferences"
192 , Api.Proxy.AppBskyActorGetPreferences.handler )
193 ; ( post
194 , "/xrpc/app.bsky.actor.putPreferences"
195 , Api.Proxy.AppBskyActorPutPreferences.handler )
196 ; (get, "/xrpc/app.bsky.feed.getFeed", Api.Proxy.AppBskyFeedGetFeed.handler)
197 ]
198
199let public_loader _root path _request =
200 match Public.read path with
201 | None ->
202 Dream.empty `Not_Found
203 | Some asset ->
204 Dream.respond
205 ~headers:[("Cache-Control", "public, max-age=31536000")]
206 asset
207
208let static_routes =
209 [Dream.get "/public/**" (Dream.static ~loader:public_loader "")]
210
211let serve () =
212 Printexc.record_backtrace true ;
213 Printexc.register_printer Errors.printer ;
214 Dream.initialize_log ~level:Env.log_level () ;
215 List.iter (fun src ->
216 match Logs.Src.name src with
217 (* useless noise on debug level *)
218 | "cohttp.lwt.io" | "cohttp.lwt.server" | "tls.tracing" | "tls.config" ->
219 Logs.Src.set_level src None
220 | _ ->
221 () )
222 @@ Logs.Src.list () ;
223 let%lwt db = Data_store.connect ~create:true () in
224 S3.Backup.start () ;
225 Dream.serve ~interface:"0.0.0.0" ~port:8008
226 @@ Dream.pipeline
227 [ Dream.logger
228 ; Dream.set_secret (Env.jwt_key |> Kleidos.privkey_to_multikey)
229 ; Dream.cookie_sessions
230 ; Xrpc.dpop_middleware
231 ; Xrpc.cors_middleware ]
232 @@ Dream.router
233 @@ List.map
234 (fun (fn, path, handler) ->
235 fn path (fun req -> handler ({req; db} : Xrpc.init)) )
236 handlers
237 @ static_routes
238 @ [ Dream.get "/xrpc/**" (Xrpc.service_proxy_handler db)
239 ; Dream.post "/xrpc/**" (Xrpc.service_proxy_handler db) ]
240
241let create_invite ?(uses = 1) () =
242 let%lwt db = Data_store.connect ~create:true () in
243 let%lwt code =
244 Api.Server.CreateInviteCode.create_invite_code ~db ~did:"admin"
245 ~use_count:uses
246 in
247 print_endline
248 ("invite code created with " ^ string_of_int uses ^ " use(s): " ^ code)
249 |> Lwt.return
250
251let migrate_blobs ?did () =
252 match did with
253 | Some did ->
254 print_endline ("migrating blobs for user " ^ did) ;
255 let%lwt _ = S3.Blob_migration.migrate_user ~did in
256 Lwt.return_unit
257 | None ->
258 print_endline "migrating all blobs to S3" ;
259 S3.Blob_migration.migrate_all ()
260
261let rebuild_mst ~did () =
262 print_endline ("rebuilding MST for " ^ did) ;
263 let%lwt repo = Repository.load did in
264 match%lwt Repository.rebuild_mst repo with
265 | Ok (commit_cid, commit) ->
266 print_endline
267 (Printf.sprintf "MST rebuilt successfully, new commit: %s (rev: %s)"
268 (Cid.to_string commit_cid) commit.rev ) ;
269 Lwt.return_unit
270 | Error exn ->
271 print_endline ("error rebuilding MST: " ^ Printexc.to_string exn) ;
272 exit 1
273
274let print_usage () =
275 print_endline
276 @@ String.trim
277 {|
278usage: pegasus [command]
279
280commands:
281 serve start the PDS
282 create-invite [uses] create an invite code with an optional number of uses (default: 1)
283 migrate-blobs migrate all local blobs to S3
284 migrate-blobs <did> migrate blobs for a specific user to S3
285 rebuild-mst <did> rebuild MST from records table (recovery tool)
286
287see also: gen-keys
288|}
289
290let () =
291 let args = Array.to_list Sys.argv |> List.tl in
292 match args with
293 | [] | ["serve"] ->
294 Lwt_main.run (serve ())
295 | ["create-invite"] ->
296 Lwt_main.run (create_invite ())
297 | ["create-invite"; uses] ->
298 let uses = int_of_string uses in
299 Lwt_main.run (create_invite ~uses ())
300 | ["migrate-blobs"] ->
301 Lwt_main.run (migrate_blobs ())
302 | ["migrate-blobs"; did] ->
303 Lwt_main.run (migrate_blobs ~did ())
304 | ["rebuild-mst"; did] ->
305 Lwt_main.run (rebuild_mst ~did ())
306 | ["help"] | ["--help"] | ["-h"] ->
307 print_usage ()
308 | cmd :: _ ->
309 print_endline ("unknown command: " ^ cmd) ;
310 print_usage () ;
311 exit 1