objective categorical abstract machine language personal data server
at main 311 lines 12 kB view raw
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