objective categorical abstract machine language personal data server
65
fork

Configure Feed

Select the types of activity you want to include in your feed.

xrpc confirmEmail, updateEmail, createInviteCodes

futurGH ff0a7abc 85515ba9

+143 -6
+9
bin/main.ml
··· 39 39 , "/xrpc/com.atproto.server.createInviteCode" 40 40 , Api.Server.CreateInviteCode.handler ) 41 41 ; ( post 42 + , "/xrpc/com.atproto.server.createInviteCodes" 43 + , Api.Server.CreateInviteCodes.handler ) 44 + ; ( post 42 45 , "/xrpc/com.atproto.server.createAccount" 43 46 , Api.Server.CreateAccount.handler ) 44 47 ; ( post ··· 64 67 , "/xrpc/com.atproto.server.requestEmailUpdate" 65 68 , Api.Server.RequestEmailUpdate.handler ) 66 69 ; ( post 70 + , "/xrpc/com.atproto.server.confirmEmail" 71 + , Api.Server.ConfirmEmail.handler ) 72 + ; ( post 67 73 , "/xrpc/com.atproto.server.requestPasswordReset" 68 74 , Api.Server.RequestPasswordReset.handler ) 69 75 ; ( post ··· 87 93 ; ( post 88 94 , "/xrpc/com.atproto.identity.updateHandle" 89 95 , Api.Identity.UpdateHandle.handler ) 96 + ; ( post 97 + , "/xrpc/com.atproto.server.updateEmail" 98 + , Api.Server.UpdateEmail.handler ) 90 99 ; (* plc *) 91 100 ( get 92 101 , "/xrpc/com.atproto.identity.getRecommendedDidCredentials"
+28
pegasus/lib/api/server/confirmEmail.ml
··· 1 + type request = {email: string; token: string} [@@deriving yojson {strict= false}] 2 + 3 + let handler = 4 + Xrpc.handler ~auth:Authorization (fun {req; auth; db; _} -> 5 + Auth.assert_account_scope auth ~attr:Oauth.Scopes.Email 6 + ~action:Oauth.Scopes.Manage ; 7 + let did = Auth.get_authed_did_exn auth in 8 + let%lwt {email; token} = Xrpc.parse_body req request_of_yojson in 9 + let email = String.lowercase_ascii email in 10 + match%lwt Data_store.get_actor_by_identifier did db with 11 + | None -> 12 + Errors.invalid_request ~name:"AccountNotFound" "account not found" 13 + | Some actor -> 14 + if String.lowercase_ascii actor.email <> email then 15 + Errors.invalid_request ~name:"InvalidEmail" "email does not match" 16 + else ( 17 + match (actor.auth_code, actor.auth_code_expires_at) with 18 + | Some auth_code, Some expires_at 19 + when String.starts_with ~prefix:"eml-" auth_code 20 + && auth_code = token 21 + && Util.now_ms () < expires_at -> 22 + let%lwt () = Data_store.confirm_email ~did db in 23 + Dream.log "email confirmed for %s" did ; 24 + Dream.empty `OK 25 + | Some _, Some expires_at when Util.now_ms () >= expires_at -> 26 + Errors.invalid_request ~name:"ExpiredToken" "token expired" 27 + | _ -> 28 + Errors.invalid_request ~name:"InvalidToken" "invalid token" ) )
+6 -6
pegasus/lib/api/server/createInviteCode.ml
··· 5 5 6 6 type response = {code: string} [@@deriving yojson {strict= false}] 7 7 8 + let generate_code did = 9 + String.sub 10 + Digestif.SHA256.(digest_string (did ^ Mist.Tid.now ()) |> to_hex) 11 + 0 8 12 + 8 13 let handler = 9 14 Xrpc.handler ~auth:Admin (fun {req; db; _} -> 10 15 let%lwt {use_count; for_account} = ··· 12 17 in 13 18 let remaining = Int.max 1 (Int.min use_count 5) in 14 19 let did = Option.value for_account ~default:"admin" in 15 - let code = 16 - String.sub 17 - Digestif.SHA256.( 18 - digest_string (did ^ Int.to_string @@ Util.now_ms ()) |> to_hex ) 19 - 0 8 20 - in 20 + let code = generate_code did in 21 21 let%lwt () = Data_store.create_invite ~code ~did ~remaining db in 22 22 Dream.json @@ Yojson.Safe.to_string @@ response_to_yojson {code} )
+36
pegasus/lib/api/server/createInviteCodes.ml
··· 1 + type request = 2 + { code_count: int [@key "codeCount"] [@default 1] 3 + ; use_count: int [@key "useCount"] 4 + ; for_accounts: string list option [@key "forAccounts"] [@default None] } 5 + [@@deriving yojson {strict= false}] 6 + 7 + type account_codes = {account: string; codes: string list} [@@deriving yojson] 8 + 9 + type response = {codes: account_codes list} [@@deriving yojson] 10 + 11 + let handler = 12 + Xrpc.handler ~auth:Admin (fun {req; db; _} -> 13 + let%lwt {code_count; use_count; for_accounts} = 14 + Xrpc.parse_body req request_of_yojson 15 + in 16 + let code_count = Int.max 1 (Int.min code_count 100) in 17 + let use_count = Int.max 1 (Int.min use_count 100) in 18 + let accounts = Option.value for_accounts ~default:["admin"] in 19 + let%lwt codes = 20 + Lwt_list.map_s 21 + (fun account -> 22 + let%lwt account_codes = 23 + Lwt_list.map_s 24 + (fun _ -> 25 + let code = CreateInviteCode.generate_code account in 26 + let%lwt () = 27 + Data_store.create_invite ~code ~did:account 28 + ~remaining:use_count db 29 + in 30 + Lwt.return code ) 31 + (List.init code_count (fun i -> i)) 32 + in 33 + Lwt.return {account; codes= account_codes} ) 34 + accounts 35 + in 36 + Dream.json @@ Yojson.Safe.to_string @@ response_to_yojson {codes} )
+43
pegasus/lib/api/server/updateEmail.ml
··· 1 + type request = 2 + { email: string 3 + ; email_auth_factor: bool option [@key "emailAuthFactor"] [@default None] 4 + ; token: string option [@default None] } 5 + [@@deriving yojson {strict= false}] 6 + 7 + let handler = 8 + Xrpc.handler ~auth:Authorization (fun {req; auth; db; _} -> 9 + Auth.assert_account_scope auth ~attr:Oauth.Scopes.Email 10 + ~action:Oauth.Scopes.Manage ; 11 + let did = Auth.get_authed_did_exn auth in 12 + let%lwt {email; token; _} = Xrpc.parse_body req request_of_yojson in 13 + let email = String.lowercase_ascii email in 14 + match%lwt Data_store.get_actor_by_identifier did db with 15 + | None -> 16 + Errors.internal_error ~msg:"actor not found" () 17 + | Some actor -> ( 18 + match actor.email_confirmed_at with 19 + | Some _ -> ( 20 + (* email is confirmed, require valid token *) 21 + match token with 22 + | None -> 23 + Errors.invalid_request ~name:"TokenRequired" 24 + "confirmation token required" 25 + | Some token -> ( 26 + match (actor.auth_code, actor.auth_code_expires_at) with 27 + | Some auth_code, Some expires_at 28 + when String.starts_with ~prefix:"eml-" auth_code 29 + && auth_code = token 30 + && Util.now_ms () < expires_at -> 31 + let%lwt () = Data_store.update_email ~did ~email db in 32 + Dream.log "email updated for %s to %s" did email ; 33 + Dream.empty `OK 34 + | Some _, Some expires_at when Util.now_ms () >= expires_at -> 35 + Errors.invalid_request ~name:"ExpiredToken" "token expired" 36 + | _ -> 37 + Errors.invalid_request ~name:"InvalidToken" "invalid token" ) 38 + ) 39 + | None -> 40 + (* email not confirmed, no token required *) 41 + let%lwt () = Data_store.update_email ~did ~email db in 42 + Dream.log "email updated for %s to %s" did email ; 43 + Dream.empty `OK ) )
+21
pegasus/lib/data_store.ml
··· 196 196 WHERE did = %string{did} 197 197 |sql}] 198 198 199 + let update_email = 200 + [%rapper 201 + execute 202 + {sql| UPDATE actors SET email = %string{email}, email_confirmed_at = NULL, auth_code = NULL, auth_code_expires_at = NULL 203 + WHERE did = %string{did} 204 + |sql}] 205 + 206 + let confirm_email = 207 + [%rapper 208 + execute 209 + {sql| UPDATE actors SET email_confirmed_at = %int{confirmed_at}, auth_code = NULL, auth_code_expires_at = NULL 210 + WHERE did = %string{did} 211 + |sql}] 212 + 199 213 (* firehose *) 200 214 let firehose_insert = 201 215 [%rapper ··· 340 354 let update_password ~did ~password conn = 341 355 let password_hash = Bcrypt.hash password |> Bcrypt.string_of_hash in 342 356 Util.use_pool conn @@ Queries.update_password ~did ~password_hash 357 + 358 + let update_email ~did ~email conn = 359 + Util.use_pool conn @@ Queries.update_email ~did ~email 360 + 361 + let confirm_email ~did conn = 362 + let confirmed_at = Util.now_ms () in 363 + Util.use_pool conn @@ Queries.confirm_email ~did ~confirmed_at 343 364 344 365 (* firehose helpers *) 345 366 let append_firehose_event conn ~time ~t ~data : int Lwt.t =