perlsky is a Perl 5 implementation of an AT Protocol Personal Data Server.
13
fork

Configure Feed

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

Expand account lifecycle and admin API coverage

alice 068241d8 4b7cebe6

+1652 -127
+4
lib/ATProto/PDS.pm
··· 5 5 6 6 use Mojo::Base 'Mojolicious', -signatures; 7 7 use Mojo::JSON (); 8 + use ATProto::PDS::API::Admin qw(register_admin_handlers); 8 9 use ATProto::PDS::API::Builtins qw(register_builtin_handlers); 10 + use ATProto::PDS::API::Misc qw(register_misc_handlers); 9 11 use ATProto::PDS::API::Repo qw(register_repo_handlers); 10 12 use ATProto::PDS::API::Registry; 11 13 use ATProto::PDS::API::Server qw(register_server_handlers); ··· 77 79 78 80 register_builtin_handlers($self->api_registry, $self); 79 81 register_server_handlers($self->api_registry, $self); 82 + register_misc_handlers($self->api_registry, $self); 80 83 register_repo_handlers($self->api_registry, $self); 81 84 register_sync_handlers($self->api_registry, $self); 85 + register_admin_handlers($self->api_registry, $self); 82 86 ATProto::PDS::XRPC::Dispatcher->new( 83 87 app => $self, 84 88 routes => $routes,
+244
lib/ATProto/PDS/API/Admin.pm
··· 1 + package ATProto::PDS::API::Admin; 2 + 3 + use v5.34; 4 + use warnings; 5 + use feature 'signatures'; 6 + no warnings 'experimental::signatures'; 7 + 8 + use Exporter 'import'; 9 + use JSON::PP (); 10 + 11 + use ATProto::PDS::API::Helpers qw(account_view find_account invite_code_view require_admin subject_key); 12 + use ATProto::PDS::API::Util qw(xrpc_error); 13 + use ATProto::PDS::Auth::Password qw(hash_password); 14 + use ATProto::PDS::Identity qw(account_did_doc normalize_handle); 15 + 16 + our @EXPORT_OK = qw(register_admin_handlers); 17 + 18 + sub register_admin_handlers ($registry, $app) { 19 + $registry->register('com.atproto.admin.getAccountInfo', sub ($c, $endpoint) { 20 + require_admin($c); 21 + my $account = $c->store->get_account_by_did($c->param('did') // q()); 22 + xrpc_error(404, 'AccountNotFound', 'Account was not found') unless $account; 23 + return account_view($account); 24 + }); 25 + 26 + $registry->register('com.atproto.admin.getAccountInfos', sub ($c, $endpoint) { 27 + require_admin($c); 28 + my @dids = $c->every_param('dids'); 29 + return { 30 + infos => [ 31 + map { account_view($_) } 32 + grep { defined } 33 + map { $c->store->get_account_by_did($_) } @dids 34 + ], 35 + }; 36 + }); 37 + 38 + $registry->register('com.atproto.admin.searchAccounts', sub ($c, $endpoint) { 39 + require_admin($c); 40 + my $page = $c->store->search_accounts( 41 + email => $c->param('email'), 42 + cursor => $c->param('cursor'), 43 + limit => $c->param('limit') // 50, 44 + ); 45 + return { 46 + (defined $page->{cursor} ? (cursor => $page->{cursor}) : ()), 47 + accounts => [ map { account_view($_) } @{ $page->{items} } ], 48 + }; 49 + }); 50 + 51 + $registry->register('com.atproto.admin.getSubjectStatus', sub ($c, $endpoint) { 52 + require_admin($c); 53 + my $subject = _subject_from_params($c); 54 + my $status = $c->store->get_subject_status(subject_key($subject)); 55 + return { 56 + subject => $subject, 57 + ($status && $status->{takedown} ? (takedown => $status->{takedown}) : ()), 58 + ($status && $status->{deactivated} ? (deactivated => $status->{deactivated}) : ()), 59 + }; 60 + }); 61 + 62 + $registry->register('com.atproto.admin.updateSubjectStatus', sub ($c, $endpoint) { 63 + require_admin($c); 64 + my $body = $c->req->json || {}; 65 + my $subject = $body->{subject} || {}; 66 + my $status = $c->store->put_subject_status( 67 + subject_key => subject_key($subject), 68 + subject => $subject, 69 + takedown => $body->{takedown}, 70 + deactivated => $body->{deactivated}, 71 + ); 72 + if (exists($subject->{did}) && !exists($subject->{uri}) && !exists($subject->{cid}) && $body->{deactivated}) { 73 + $c->store->update_account( 74 + $subject->{did}, 75 + deactivated_at => $body->{deactivated}{applied} ? time : undef, 76 + ); 77 + } 78 + return { 79 + subject => $status->{subject}, 80 + ($status->{takedown} ? (takedown => $status->{takedown}) : ()), 81 + ($status->{deactivated} ? (deactivated => $status->{deactivated}) : ()), 82 + }; 83 + }); 84 + 85 + $registry->register('com.atproto.admin.sendEmail', sub ($c, $endpoint) { 86 + require_admin($c); 87 + my $body = $c->req->json || {}; 88 + my $account = $c->store->get_account_by_did($body->{recipientDid} // q()); 89 + $c->store->log_outbound_email( 90 + recipient_did => $body->{recipientDid}, 91 + recipient_email => $account ? $account->{email} : undef, 92 + sender_did => $body->{senderDid}, 93 + subject => $body->{subject}, 94 + content => $body->{content}, 95 + comment => $body->{comment}, 96 + sent => 1, 97 + ); 98 + return { sent => JSON::PP::true }; 99 + }); 100 + 101 + $registry->register('com.atproto.admin.updateAccountHandle', sub ($c, $endpoint) { 102 + require_admin($c); 103 + my $body = $c->req->json || {}; 104 + my $account = $c->store->get_account_by_did($body->{did} // q()); 105 + xrpc_error(404, 'AccountNotFound', 'Account was not found') unless $account; 106 + my $handle = normalize_handle($body->{handle}, $c->config_value('service_handle_domain', 'localhost')); 107 + xrpc_error(400, 'InvalidHandle', 'Requested handle is invalid') unless defined $handle; 108 + my $existing = $c->store->get_account_by_handle($handle); 109 + xrpc_error(400, 'HandleNotAvailable', 'That handle is already registered') 110 + if $existing && ($existing->{did} // q()) ne $account->{did}; 111 + $c->store->update_account( 112 + $account->{did}, 113 + handle => $handle, 114 + did_doc => account_did_doc($c->app->settings, { %$account, handle => $handle }), 115 + ); 116 + return {}; 117 + }); 118 + 119 + $registry->register('com.atproto.admin.updateAccountPassword', sub ($c, $endpoint) { 120 + require_admin($c); 121 + my $body = $c->req->json || {}; 122 + xrpc_error(400, 'InvalidPassword', 'Passwords must be at least 8 characters long') 123 + if length($body->{password} // q()) < 8; 124 + my $account = $c->store->get_account_by_did($body->{did} // q()); 125 + xrpc_error(404, 'AccountNotFound', 'Account was not found') unless $account; 126 + my $password_record = hash_password($body->{password}); 127 + $c->store->update_account( 128 + $account->{did}, 129 + password_hash => $password_record->{hash}, 130 + password_salt => $password_record->{salt}, 131 + ); 132 + return {}; 133 + }); 134 + 135 + $registry->register('com.atproto.admin.updateAccountEmail', sub ($c, $endpoint) { 136 + require_admin($c); 137 + my $body = $c->req->json || {}; 138 + my $account = find_account($c, $body->{account} // q()); 139 + xrpc_error(404, 'AccountNotFound', 'Account was not found') unless $account; 140 + $c->store->update_account( 141 + $account->{did}, 142 + email => $body->{email}, 143 + email_confirmed_at => undef, 144 + ); 145 + return {}; 146 + }); 147 + 148 + $registry->register('com.atproto.admin.deleteAccount', sub ($c, $endpoint) { 149 + require_admin($c); 150 + my $body = $c->req->json || {}; 151 + my $account = $c->store->get_account_by_did($body->{did} // q()); 152 + xrpc_error(404, 'AccountNotFound', 'Account was not found') unless $account; 153 + $c->store->txn(sub ($dbh) { 154 + $c->store->update_account( 155 + $account->{did}, 156 + deactivated_at => time, 157 + deleted_at => time, 158 + ); 159 + $c->store->revoke_sessions_by_did($account->{did}); 160 + $c->store->revoke_app_passwords_by_did($account->{did}); 161 + }); 162 + return {}; 163 + }); 164 + 165 + $registry->register('com.atproto.admin.disableInviteCodes', sub ($c, $endpoint) { 166 + require_admin($c); 167 + my $body = $c->req->json || {}; 168 + $c->store->disable_invite_codes( 169 + codes => $body->{codes}, 170 + accounts => $body->{accounts}, 171 + ); 172 + return {}; 173 + }); 174 + 175 + $registry->register('com.atproto.admin.getInviteCodes', sub ($c, $endpoint) { 176 + require_admin($c); 177 + my $page = $c->store->list_invite_codes( 178 + sort => $c->param('sort') // 'recent', 179 + cursor => $c->param('cursor'), 180 + limit => $c->param('limit') // 100, 181 + ); 182 + return { 183 + (defined $page->{cursor} ? (cursor => $page->{cursor}) : ()), 184 + codes => [ map { invite_code_view($c->store, $_) } @{ $page->{items} } ], 185 + }; 186 + }); 187 + 188 + $registry->register('com.atproto.admin.disableAccountInvites', sub ($c, $endpoint) { 189 + require_admin($c); 190 + my $body = $c->req->json || {}; 191 + my $account = $c->store->get_account_by_did($body->{account} // q()); 192 + xrpc_error(404, 'AccountNotFound', 'Account was not found') unless $account; 193 + $c->store->update_account( 194 + $account->{did}, 195 + invites_disabled => 1, 196 + invite_note => $body->{note}, 197 + ); 198 + return {}; 199 + }); 200 + 201 + $registry->register('com.atproto.admin.enableAccountInvites', sub ($c, $endpoint) { 202 + require_admin($c); 203 + my $body = $c->req->json || {}; 204 + my $account = $c->store->get_account_by_did($body->{account} // q()); 205 + xrpc_error(404, 'AccountNotFound', 'Account was not found') unless $account; 206 + $c->store->update_account( 207 + $account->{did}, 208 + invites_disabled => 0, 209 + invite_note => $body->{note}, 210 + ); 211 + return {}; 212 + }); 213 + 214 + $registry->register('com.atproto.admin.updateAccountSigningKey', sub ($c, $endpoint) { 215 + require_admin($c); 216 + my $body = $c->req->json || {}; 217 + my $account = $c->store->get_account_by_did($body->{did} // q()); 218 + xrpc_error(404, 'AccountNotFound', 'Account was not found') unless $account; 219 + my $multibase = $body->{signingKey} // q(); 220 + $multibase =~ s/\Adid:key://; 221 + my $updated = { 222 + %$account, 223 + public_key_multibase => $multibase, 224 + }; 225 + $c->store->update_account( 226 + $account->{did}, 227 + public_key_multibase => $multibase, 228 + did_doc => account_did_doc($c->app->settings, $updated), 229 + ); 230 + return {}; 231 + }); 232 + } 233 + 234 + sub _subject_from_params ($c) { 235 + return { did => $c->param('did') } if defined($c->param('did')) && !defined($c->param('uri')) && !defined($c->param('blob')); 236 + return { uri => $c->param('uri') } if defined $c->param('uri'); 237 + return { 238 + did => $c->param('did'), 239 + cid => $c->param('blob'), 240 + } if defined $c->param('blob'); 241 + xrpc_error(400, 'InvalidRequest', 'A subject reference is required'); 242 + } 243 + 244 + 1;
+115
lib/ATProto/PDS/API/Helpers.pm
··· 1 + package ATProto::PDS::API::Helpers; 2 + 3 + use v5.34; 4 + use warnings; 5 + use feature 'signatures'; 6 + no warnings 'experimental::signatures'; 7 + 8 + use Exporter 'import'; 9 + use JSON::PP (); 10 + use MIME::Base64 qw(decode_base64); 11 + 12 + use ATProto::PDS::API::Util qw(iso8601 xrpc_error); 13 + use ATProto::PDS::Auth::Password qw(verify_password); 14 + 15 + our @EXPORT_OK = qw( 16 + account_view 17 + find_account 18 + invite_code_view 19 + require_admin 20 + subject_key 21 + verify_account_password 22 + ); 23 + 24 + sub require_admin ($c) { 25 + my $configured = $c->config_value('admin_password'); 26 + xrpc_error(503, 'AdminAuthUnavailable', 'Admin password is not configured') 27 + unless defined $configured && length $configured; 28 + 29 + my $auth = $c->req->headers->authorization // q(); 30 + my $provided; 31 + if ($auth =~ /\ABearer\s+(.+)\z/i) { 32 + $provided = $1; 33 + } elsif ($auth =~ /\ABasic\s+(.+)\z/i) { 34 + my $decoded = decode_base64($1); 35 + my (undef, $password) = split /:/, $decoded, 2; 36 + $provided = $password; 37 + } 38 + 39 + xrpc_error(401, 'AuthRequired', 'Admin authorization is required') 40 + unless defined $provided && length $provided; 41 + xrpc_error(403, 'InvalidAdminToken', 'Invalid admin authorization') 42 + unless $provided eq $configured; 43 + return 1; 44 + } 45 + 46 + sub find_account ($c, $identifier) { 47 + return undef unless defined $identifier && length $identifier; 48 + my $account = $c->store->get_account_by_identifier($identifier); 49 + return $account if $account; 50 + return $c->store->get_account_by_email($identifier); 51 + } 52 + 53 + sub verify_account_password ($c, $account, $password) { 54 + return 0 unless $account && defined $password; 55 + return 1 if verify_password($password, $account->{password_salt}, $account->{password_hash}); 56 + 57 + for my $app_password (@{ $c->store->list_app_passwords_by_did($account->{did}) }) { 58 + next if defined $app_password->{revoked_at}; 59 + my ($salt_hex, $hash) = split /:/, ($app_password->{password_hash} // q()), 2; 60 + next unless defined $salt_hex && defined $hash; 61 + my $salt = pack('H*', $salt_hex); 62 + return 1 if verify_password($password, $salt, $hash); 63 + } 64 + 65 + return 0; 66 + } 67 + 68 + sub account_view ($account) { 69 + return { 70 + did => $account->{did}, 71 + handle => $account->{handle}, 72 + ($account->{email} ? (email => $account->{email}) : ()), 73 + indexedAt => iso8601($account->{updated_at} // $account->{created_at}), 74 + invitesDisabled => ($account->{invites_disabled} ? JSON::PP::true : JSON::PP::false), 75 + (defined($account->{email_confirmed_at}) ? (emailConfirmedAt => iso8601($account->{email_confirmed_at})) : ()), 76 + ($account->{invite_note} ? (inviteNote => $account->{invite_note}) : ()), 77 + (defined($account->{deactivated_at}) ? (deactivatedAt => iso8601($account->{deactivated_at})) : ()), 78 + }; 79 + } 80 + 81 + sub invite_code_view ($store, $row) { 82 + my $uses = $store->list_invite_code_uses($row->{code}); 83 + my $consumed = scalar @$uses; 84 + my $available = ($row->{use_count} // 0) - $consumed; 85 + $available = 0 if $available < 0; 86 + 87 + return { 88 + code => $row->{code}, 89 + available => $row->{disabled} ? 0 : $available, 90 + disabled => $row->{disabled} ? JSON::PP::true : JSON::PP::false, 91 + forAccount => $row->{for_account} // q(), 92 + createdBy => $row->{created_by} // q(), 93 + createdAt => iso8601($row->{created_at}), 94 + uses => [ 95 + map { 96 + +{ 97 + usedBy => $_->{used_by}, 98 + usedAt => iso8601($_->{used_at}), 99 + } 100 + } @$uses 101 + ], 102 + }; 103 + } 104 + 105 + sub subject_key ($subject) { 106 + return 'repo:' . ($subject->{did} // q()) 107 + if ref($subject) eq 'HASH' && exists $subject->{did} && !exists $subject->{uri} && !exists $subject->{cid}; 108 + return 'record:' . ($subject->{uri} // q()) . ':' . ($subject->{cid} // q()) 109 + if ref($subject) eq 'HASH' && exists $subject->{uri}; 110 + return 'blob:' . ($subject->{did} // q()) . ':' . ($subject->{cid} // q()) 111 + if ref($subject) eq 'HASH' && exists $subject->{did} && exists $subject->{cid}; 112 + xrpc_error(400, 'InvalidRequest', 'Unsupported subject payload'); 113 + } 114 + 115 + 1;
+304
lib/ATProto/PDS/API/Misc.pm
··· 1 + package ATProto::PDS::API::Misc; 2 + 3 + use v5.34; 4 + use warnings; 5 + use feature 'signatures'; 6 + no warnings 'experimental::signatures'; 7 + 8 + use Exporter 'import'; 9 + use JSON::PP (); 10 + 11 + use ATProto::PDS::API::Helpers qw(find_account subject_key); 12 + use ATProto::PDS::API::Server qw(require_auth); 13 + use ATProto::PDS::API::Util qw(iso8601 xrpc_error); 14 + use ATProto::PDS::Auth::Password qw(hash_password random_hex); 15 + use ATProto::PDS::Identity qw(account_did_doc normalize_handle service_did service_did_doc); 16 + use ATProto::PDS::Repo::CID; 17 + use ATProto::PDS::Repo::DagCbor qw(encode_dag_cbor); 18 + 19 + our @EXPORT_OK = qw(register_misc_handlers); 20 + 21 + sub register_misc_handlers ($registry, $app) { 22 + $registry->register('com.atproto.identity.getRecommendedDidCredentials', sub ($c, $endpoint) { 23 + return { 24 + rotationKeys => [], 25 + alsoKnownAs => [], 26 + verificationMethods => {}, 27 + services => { 28 + atproto_pds => service_did_doc($c->app->settings)->{service}[0], 29 + }, 30 + }; 31 + }); 32 + 33 + $registry->register('com.atproto.identity.refreshIdentity', sub ($c, $endpoint) { 34 + my $body = $c->req->json || {}; 35 + my $identifier = $body->{identifier} // q(); 36 + my $account = find_account($c, $identifier); 37 + if ($account) { 38 + return { 39 + did => $account->{did}, 40 + handle => $account->{handle}, 41 + didDoc => $account->{did_doc} || account_did_doc($c->app->settings, $account), 42 + }; 43 + } 44 + 45 + my $service_did = service_did($c->app->settings); 46 + if (lc($identifier) eq lc($service_did)) { 47 + return { 48 + did => $service_did, 49 + handle => $c->config_value('service_handle_domain', 'localhost'), 50 + didDoc => service_did_doc($c->app->settings), 51 + }; 52 + } 53 + 54 + xrpc_error( 55 + 404, 56 + ($identifier =~ /^did:/ ? 'DidNotFound' : 'HandleNotFound'), 57 + "No identity found for $identifier", 58 + ); 59 + }); 60 + 61 + $registry->register('com.atproto.identity.requestPlcOperationSignature', sub ($c, $endpoint) { 62 + my (undef, $account) = require_auth($c, audience => 'access', allow_refresh => 1); 63 + my $token = $c->store->create_action_token( 64 + did => $account->{did}, 65 + email => $account->{email}, 66 + purpose => 'plc_signature', 67 + expires_at => time + 3600, 68 + ); 69 + $c->store->log_outbound_email( 70 + recipient_did => $account->{did}, 71 + recipient_email => $account->{email}, 72 + subject => 'perlds PLC operation signature', 73 + content => "Use token $token->{token} to sign your PLC operation.", 74 + ) if $account->{email}; 75 + return {}; 76 + }); 77 + 78 + $registry->register('com.atproto.identity.signPlcOperation', sub ($c, $endpoint) { 79 + my (undef, $account) = require_auth($c, audience => 'access', allow_refresh => 1); 80 + my $body = $c->req->json || {}; 81 + if (defined($body->{token}) && length($body->{token})) { 82 + my $token = $c->store->get_action_token($body->{token}); 83 + xrpc_error(400, 'InvalidToken', 'Token was not found') unless $token; 84 + xrpc_error(400, 'InvalidToken', 'Token purpose did not match') unless ($token->{purpose} // q()) eq 'plc_signature'; 85 + xrpc_error(400, 'ExpiredToken', 'Token has expired') 86 + if defined($token->{expires_at}) && $token->{expires_at} < time; 87 + xrpc_error(400, 'InvalidToken', 'Token was not issued for this account') 88 + unless ($token->{did} // q()) eq $account->{did}; 89 + $c->store->consume_action_token($token->{token}); 90 + } 91 + return { 92 + operation => { 93 + type => 'com.atproto.identity.plcOperation', 94 + did => $account->{did}, 95 + alsoKnownAs => $body->{alsoKnownAs} // $account->{did_doc}{alsoKnownAs} // [], 96 + verificationMethods => $body->{verificationMethods} // {}, 97 + services => $body->{services} // {}, 98 + rotationKeys => $body->{rotationKeys} // [], 99 + signedAt => iso8601(), 100 + }, 101 + }; 102 + }); 103 + 104 + $registry->register('com.atproto.identity.submitPlcOperation', sub ($c, $endpoint) { 105 + my $body = $c->req->json || {}; 106 + my $operation = $body->{operation} || {}; 107 + my $account = $c->store->get_account_by_did($operation->{did} // q()); 108 + if (!$account) { 109 + my (undef, $authed) = require_auth($c, audience => 'access', allow_refresh => 1); 110 + $account = $authed; 111 + } 112 + xrpc_error(404, 'DidNotFound', 'Account was not found') unless $account; 113 + 114 + my $did_doc = $account->{did_doc} || account_did_doc($c->app->settings, $account); 115 + $did_doc->{alsoKnownAs} = $operation->{alsoKnownAs} if exists $operation->{alsoKnownAs}; 116 + $did_doc->{verificationMethod} = $operation->{verificationMethods} if exists $operation->{verificationMethods}; 117 + $did_doc->{service} = $operation->{services} if exists $operation->{services}; 118 + $c->store->update_account($account->{did}, did_doc => $did_doc); 119 + return {}; 120 + }); 121 + 122 + $registry->register('com.atproto.identity.updateHandle', sub ($c, $endpoint) { 123 + my (undef, $account) = require_auth($c, audience => 'access', allow_refresh => 1); 124 + my $body = $c->req->json || {}; 125 + my $domain = $c->config_value('service_handle_domain', 'localhost'); 126 + my $handle = normalize_handle($body->{handle}, $domain); 127 + xrpc_error(400, 'InvalidHandle', 'Requested handle is invalid') unless defined $handle; 128 + my $existing = $c->store->get_account_by_handle($handle); 129 + xrpc_error(400, 'HandleNotAvailable', 'That handle is already registered') 130 + if $existing && ($existing->{did} // q()) ne $account->{did}; 131 + xrpc_error(400, 'HandleNotAvailable', 'That handle is reserved') 132 + if $c->store->get_reserved_handle($handle); 133 + my $updated = $c->store->update_account( 134 + $account->{did}, 135 + handle => $handle, 136 + did_doc => account_did_doc($c->app->settings, { %$account, handle => $handle }), 137 + ); 138 + $c->store->append_event( 139 + did => $updated->{did}, 140 + type => 'identity', 141 + rev => $updated->{repo_rev}, 142 + payload => { 143 + did => $updated->{did}, 144 + handle => $updated->{handle}, 145 + }, 146 + ); 147 + return {}; 148 + }); 149 + 150 + $registry->register('com.atproto.lexicon.resolveLexicon', sub ($c, $endpoint) { 151 + my $nsid = $c->param('nsid') // q(); 152 + my $schema = $c->lexicons->get($nsid); 153 + xrpc_error(404, 'LexiconNotFound', "No lexicon found for $nsid") unless $schema; 154 + my $bytes = encode_dag_cbor($schema); 155 + my $cid = ATProto::PDS::Repo::CID->for_dag_cbor($bytes)->to_string; 156 + return { 157 + uri => 'at://' . service_did($c->app->settings) . '/com.atproto.lexicon.schema/' . $nsid, 158 + cid => $cid, 159 + schema => $schema, 160 + }; 161 + }); 162 + 163 + $registry->register('com.atproto.moderation.createReport', sub ($c, $endpoint) { 164 + my (undef, $account) = require_auth($c, audience => 'access', allow_refresh => 1); 165 + my $body = $c->req->json || {}; 166 + my $row = $c->store->create_report( 167 + reason_type => $body->{reasonType}, 168 + reason => $body->{reason}, 169 + subject => $body->{subject}, 170 + reported_by => $account->{did}, 171 + mod_tool => $body->{modTool}, 172 + ); 173 + return { 174 + id => 0 + $row->{id}, 175 + reasonType => $row->{reason_type}, 176 + ($row->{reason} ? (reason => $row->{reason}) : ()), 177 + subject => $row->{subject}, 178 + reportedBy => $row->{reported_by}, 179 + createdAt => iso8601($row->{created_at}), 180 + }; 181 + }); 182 + 183 + $registry->register('com.atproto.label.queryLabels', sub ($c, $endpoint) { 184 + my $patterns = [ $c->every_param('uriPatterns') ]; 185 + xrpc_error(400, 'InvalidRequest', 'uriPatterns is required') unless @$patterns; 186 + my @labels = grep { _matches_patterns($_->{uri}, $patterns) } @{ _current_labels($c) }; 187 + my $limit = $c->param('limit') // 50; 188 + $limit = 250 if $limit > 250; 189 + my @slice = @labels[0 .. (@labels < $limit ? $#labels : $limit - 1)]; 190 + return { 191 + labels => \@slice, 192 + }; 193 + }); 194 + 195 + $registry->register('com.atproto.temp.fetchLabels', sub ($c, $endpoint) { 196 + my @labels = @{ _current_labels($c) }; 197 + my $limit = $c->param('limit') // 50; 198 + $limit = 250 if $limit > 250; 199 + my @slice = @labels[0 .. (@labels < $limit ? $#labels : $limit - 1)]; 200 + return { 201 + labels => \@slice, 202 + }; 203 + }); 204 + 205 + $registry->register('com.atproto.label.subscribeLabels', sub ($c, $endpoint) { 206 + my $cursor = int($c->param('cursor') // 0); 207 + my @labels = @{ _current_labels($c) }; 208 + my $seq = $cursor + 1; 209 + if (@labels) { 210 + $c->send({ json => { 211 + seq => $seq, 212 + labels => \@labels, 213 + }}); 214 + } 215 + $c->finish(1000); 216 + return; 217 + }); 218 + 219 + $registry->register('com.atproto.temp.addReservedHandle', sub ($c, $endpoint) { 220 + my $body = $c->req->json || {}; 221 + my $domain = $c->config_value('service_handle_domain', 'localhost'); 222 + my $handle = normalize_handle($body->{handle}, $domain); 223 + xrpc_error(400, 'InvalidHandle', 'Requested handle is invalid') unless defined $handle; 224 + $c->store->reserve_handle($handle); 225 + return {}; 226 + }); 227 + 228 + $registry->register('com.atproto.temp.checkSignupQueue', sub ($c, $endpoint) { 229 + return { 230 + activated => JSON::PP::true, 231 + }; 232 + }); 233 + 234 + $registry->register('com.atproto.temp.dereferenceScope', sub ($c, $endpoint) { 235 + my $scope = $c->param('scope') // q(); 236 + xrpc_error(400, 'InvalidScopeReference', 'Scope reference must start with ref:') 237 + unless $scope =~ /\Aref:(.+)\z/; 238 + xrpc_error(400, 'InvalidScopeReference', 'Scope reference was empty') unless length $1; 239 + return { 240 + scope => $1, 241 + }; 242 + }); 243 + 244 + $registry->register('com.atproto.temp.requestPhoneVerification', sub ($c, $endpoint) { 245 + return {}; 246 + }); 247 + 248 + $registry->register('com.atproto.temp.revokeAccountCredentials', sub ($c, $endpoint) { 249 + my $body = $c->req->json || {}; 250 + my $account = find_account($c, $body->{account} // q()); 251 + xrpc_error(404, 'AccountNotFound', 'Account was not found') unless $account; 252 + my $password_record = hash_password(random_hex(16)); 253 + $c->store->txn(sub ($dbh) { 254 + $c->store->update_account( 255 + $account->{did}, 256 + password_hash => $password_record->{hash}, 257 + password_salt => $password_record->{salt}, 258 + ); 259 + $c->store->revoke_sessions_by_did($account->{did}); 260 + $c->store->revoke_app_passwords_by_did($account->{did}); 261 + }); 262 + return {}; 263 + }); 264 + } 265 + 266 + sub _current_labels ($c) { 267 + my $src = service_did($c->app->settings); 268 + my @labels; 269 + for my $status (@{ $c->store->list_subject_statuses }) { 270 + next unless $status->{takedown} && $status->{takedown}{applied}; 271 + my ($uri, $cid) = _subject_uri_and_cid($status->{subject}); 272 + push @labels, { 273 + ver => 1, 274 + src => $src, 275 + uri => $uri, 276 + (defined $cid ? (cid => $cid) : ()), 277 + val => '!hide', 278 + cts => iso8601($status->{updated_at}), 279 + }; 280 + } 281 + return \@labels; 282 + } 283 + 284 + sub _subject_uri_and_cid ($subject) { 285 + if (exists $subject->{uri}) { 286 + return ($subject->{uri}, $subject->{cid}); 287 + } 288 + if (exists $subject->{did} && exists $subject->{cid}) { 289 + return ($subject->{recordUri} || ('at://' . $subject->{did}), $subject->{cid}); 290 + } 291 + return ('at://' . ($subject->{did} // q()), undef); 292 + } 293 + 294 + sub _matches_patterns ($uri, $patterns) { 295 + for my $pattern (@$patterns) { 296 + return 1 if $pattern eq $uri; 297 + if ($pattern =~ /\A(.+)\*\z/ && index($uri, $1) == 0) { 298 + return 1; 299 + } 300 + } 301 + return 0; 302 + } 303 + 304 + 1;
+391 -124
lib/ATProto/PDS/API/Server.pm
··· 6 6 no warnings 'experimental::signatures'; 7 7 8 8 use Exporter 'import'; 9 - use Mojo::JSON qw(false true); 9 + use JSON::PP (); 10 10 11 + use ATProto::PDS::API::Helpers qw(find_account invite_code_view verify_account_password); 12 + use ATProto::PDS::API::Util qw(iso8601 xrpc_error); 11 13 use ATProto::PDS::Auth::JWT qw(decode_jwt encode_jwt); 12 - use ATProto::PDS::Auth::Password qw(hash_password random_hex verify_password); 14 + use ATProto::PDS::Auth::Password qw(hash_password random_hex); 13 15 use ATProto::PDS::Identity qw(account_did account_did_doc normalize_handle service_did); 14 16 15 - our @EXPORT_OK = qw(register_server_handlers require_auth session_view issue_session); 17 + our @EXPORT_OK = qw(register_server_handlers require_auth session_view); 16 18 17 19 sub register_server_handlers ($registry, $app) { 18 20 $registry->register('com.atproto.server.createAccount', sub ($c, $endpoint) { 19 21 my $body = $c->req->json || {}; 20 22 my $domain = $c->config_value('service_handle_domain', 'localhost'); 21 23 my $handle = normalize_handle($body->{handle}, $domain); 22 - _xrpc_error(400, 'InvalidHandle', 'Requested handle is invalid') unless defined $handle; 23 - _xrpc_error(400, 'HandleNotAvailable', 'That handle is already registered') 24 + xrpc_error(400, 'InvalidHandle', 'Requested handle is invalid') unless defined $handle; 25 + xrpc_error(400, 'HandleNotAvailable', 'That handle is already registered') 24 26 if $c->store->get_account_by_handle($handle); 27 + xrpc_error(400, 'HandleNotAvailable', 'That handle is reserved') 28 + if $c->store->get_reserved_handle($handle); 25 29 26 - my $password = $body->{password} // ''; 27 - _xrpc_error(400, 'InvalidPassword', 'Passwords must be at least 8 characters long') 30 + my $password = $body->{password} // q(); 31 + xrpc_error(400, 'InvalidPassword', 'Passwords must be at least 8 characters long') 28 32 if length($password) < 8; 29 33 34 + my $invite; 35 + if (defined($body->{inviteCode}) && length($body->{inviteCode})) { 36 + $invite = $c->store->get_invite_code($body->{inviteCode}); 37 + xrpc_error(400, 'InvalidInviteCode', 'Invite code is not valid') unless $invite; 38 + my $available = ($invite->{use_count} // 0) - ($invite->{use_count_consumed} // 0); 39 + xrpc_error(400, 'InvalidInviteCode', 'Invite code has been exhausted') 40 + if $invite->{disabled} || $available <= 0; 41 + } 42 + 30 43 my $account_id = random_hex(8); 31 44 my $did = $body->{did} || account_did($c->app->settings, $account_id); 32 - my $keys = $c->repo_manager->generate_signing_key; 45 + my $reserved = $body->{did} ? $c->store->get_reserved_signing_key($did) : undef; 46 + my $keys = ($reserved && !defined $reserved->{claimed_at}) 47 + ? { 48 + private_key => $reserved->{private_key}, 49 + public_key => $reserved->{public_key}, 50 + public_key_multibase => $reserved->{public_key_multibase}, 51 + } 52 + : $c->repo_manager->generate_signing_key; 33 53 my $password_record = hash_password($password); 34 54 my $did_doc = account_did_doc($c->app->settings, { 35 - account_id => $account_id, 36 - did => $did, 37 - handle => $handle, 38 - public_key_multibase => $keys->{public_key_multibase}, 55 + account_id => $account_id, 56 + did => $did, 57 + handle => $handle, 58 + public_key_multibase => $keys->{public_key_multibase}, 39 59 }); 40 60 41 61 my $account = $c->store->create_account( 42 - account_id => $account_id, 43 - did => $did, 44 - handle => $handle, 45 - email => $body->{email}, 46 - password_hash => $password_record->{hash}, 47 - password_salt => $password_record->{salt}, 48 - did_doc => $did_doc, 49 - private_key => $keys->{private_key}, 50 - public_key => $keys->{public_key}, 51 - public_key_multibase => $keys->{public_key_multibase}, 62 + account_id => $account_id, 63 + did => $did, 64 + handle => $handle, 65 + email => $body->{email}, 66 + email_confirmed_at => $body->{email} ? time : undef, 67 + password_hash => $password_record->{hash}, 68 + password_salt => $password_record->{salt}, 69 + did_doc => $did_doc, 70 + private_key => $keys->{private_key}, 71 + public_key => $keys->{public_key}, 72 + public_key_multibase => $keys->{public_key_multibase}, 52 73 ); 53 74 54 75 my $repo = $c->repo_manager->initialize_repo($account); ··· 59 80 did_doc => account_did_doc($c->app->settings, $account), 60 81 ); 61 82 62 - return issue_session($c, $account); 83 + $c->store->record_invite_code_use( 84 + code => $invite->{code}, 85 + used_by => $account->{did}, 86 + ) if $invite; 87 + $c->store->claim_reserved_signing_key($did) if $reserved && !defined $reserved->{claimed_at}; 88 + 89 + return _issue_session($c, $account); 63 90 }); 64 91 65 92 $registry->register('com.atproto.server.createSession', sub ($c, $endpoint) { 66 93 my $body = $c->req->json || {}; 67 - my $account = _find_account($c, $body->{identifier} // ''); 68 - _xrpc_error(401, 'AuthRequired', 'Invalid identifier or password') unless $account; 69 - 70 - my $password = $body->{password} // ''; 71 - my $valid = verify_password($password, $account->{password_salt}, $account->{password_hash}); 72 - unless ($valid) { 73 - for my $app_password (@{ $c->store->list_app_passwords_by_did($account->{did}) }) { 74 - next if defined $app_password->{revoked_at}; 75 - my ($salt_hex, $hash) = split /:/, ($app_password->{password_hash} // q()), 2; 76 - next unless defined $salt_hex && defined $hash; 77 - my $salt = pack('H*', $salt_hex); 78 - if (verify_password($password, $salt, $hash)) { 79 - $valid = 1; 80 - last; 81 - } 82 - } 83 - } 84 - 85 - _xrpc_error(401, 'AuthRequired', 'Invalid identifier or password') unless $valid; 86 - return issue_session($c, $account); 94 + my $account = find_account($c, $body->{identifier} // q()); 95 + xrpc_error(401, 'AuthRequired', 'Invalid identifier or password') unless $account; 96 + xrpc_error(403, 'AccountDeleted', 'Account has been deleted') if defined $account->{deleted_at}; 97 + xrpc_error(401, 'AuthRequired', 'Invalid identifier or password') 98 + unless verify_account_password($c, $account, $body->{password} // q()); 99 + return _issue_session($c, $account); 87 100 }); 88 101 89 102 $registry->register('com.atproto.server.getSession', sub ($c, $endpoint) { 90 - my ($claims, $account) = require_auth($c, audience => 'access', allow_refresh => 1); 103 + my (undef, $account) = require_auth($c, audience => 'access', allow_refresh => 1); 91 104 return session_view($account); 92 105 }); 93 106 94 107 $registry->register('com.atproto.server.refreshSession', sub ($c, $endpoint) { 95 108 my ($claims, $account) = require_auth($c, audience => 'refresh'); 96 109 my $session = $c->store->get_session($claims->{jti}); 97 - _xrpc_error(401, 'InvalidToken', 'Refresh session was not found') unless $session; 98 - _xrpc_error(401, 'ExpiredToken', 'Refresh session has already been revoked') if defined $session->{revoked_at}; 110 + xrpc_error(401, 'InvalidToken', 'Refresh session was not found') unless $session; 111 + xrpc_error(401, 'ExpiredToken', 'Refresh session has already been revoked') if defined $session->{revoked_at}; 99 112 $c->store->revoke_session($session->{id}); 100 - return issue_session($c, $account); 113 + return _issue_session($c, $account); 101 114 }); 102 115 103 116 $registry->register('com.atproto.server.deleteSession', sub ($c, $endpoint) { 104 - my ($claims, $account) = require_auth($c, audience => 'refresh', allow_refresh => 1); 117 + my ($claims) = require_auth($c, audience => 'refresh', allow_refresh => 1); 105 118 my $session = $c->store->get_session($claims->{jti}); 106 119 $c->store->revoke_session($session->{id}) if $session; 107 120 return {}; 108 121 }); 109 122 110 123 $registry->register('com.atproto.server.checkAccountStatus', sub ($c, $endpoint) { 111 - my ($claims, $account) = require_auth($c, audience => 'access', allow_refresh => 1); 124 + my (undef, $account) = require_auth($c, audience => 'access', allow_refresh => 1); 112 125 return { 113 - active => !defined($account->{deactivated_at}) ? true : false, 114 - status => defined($account->{deactivated_at}) ? 'deactivated' : undef, 126 + active => (!defined($account->{deactivated_at}) && !defined($account->{deleted_at})) 127 + ? JSON::PP::true 128 + : JSON::PP::false, 129 + (defined($account->{deleted_at}) ? (status => 'deleted') : ()), 130 + (defined($account->{deactivated_at}) && !defined($account->{deleted_at}) ? (status => 'deactivated') : ()), 115 131 }; 116 132 }); 117 133 118 134 $registry->register('com.atproto.server.createAppPassword', sub ($c, $endpoint) { 119 - my ($claims, $account) = require_auth($c, audience => 'access', allow_refresh => 1); 135 + my (undef, $account) = require_auth($c, audience => 'access', allow_refresh => 1); 120 136 my $body = $c->req->json || {}; 121 - my $name = $body->{name} // ''; 122 - _xrpc_error(400, 'InvalidRequest', 'App password name is required') unless length $name; 137 + my $name = $body->{name} // q(); 138 + xrpc_error(400, 'InvalidRequest', 'App password name is required') unless length $name; 123 139 124 140 my $password = _new_app_password(); 125 141 my $password_record = hash_password($password); ··· 132 148 return { 133 149 name => $row->{name}, 134 150 password => $password, 135 - createdAt => _iso8601($row->{created_at}), 136 - privileged => $body->{privileged} ? true : false, 151 + createdAt => iso8601($row->{created_at}), 152 + privileged => $body->{privileged} ? JSON::PP::true : JSON::PP::false, 137 153 }; 138 154 }); 139 155 140 156 $registry->register('com.atproto.server.listAppPasswords', sub ($c, $endpoint) { 141 - my ($claims, $account) = require_auth($c, audience => 'access', allow_refresh => 1); 157 + my (undef, $account) = require_auth($c, audience => 'access', allow_refresh => 1); 142 158 my $rows = $c->store->list_app_passwords_by_did($account->{did}); 143 159 return { 144 160 passwords => [ 145 161 map { 146 162 +{ 147 163 name => $_->{name}, 148 - createdAt => _iso8601($_->{created_at}), 149 - privileged => false, 164 + createdAt => iso8601($_->{created_at}), 165 + privileged => JSON::PP::false, 150 166 } 151 167 } grep { !defined $_->{revoked_at} } @$rows 152 168 ], ··· 154 170 }); 155 171 156 172 $registry->register('com.atproto.server.revokeAppPassword', sub ($c, $endpoint) { 157 - my ($claims, $account) = require_auth($c, audience => 'access', allow_refresh => 1); 173 + my (undef, $account) = require_auth($c, audience => 'access', allow_refresh => 1); 158 174 my $body = $c->req->json || {}; 159 - my $name = $body->{name} // ''; 160 - _xrpc_error(400, 'InvalidRequest', 'App password name is required') unless length $name; 175 + my $name = $body->{name} // q(); 176 + xrpc_error(400, 'InvalidRequest', 'App password name is required') unless length $name; 161 177 my $row = $c->store->get_app_password_by_name($account->{did}, $name); 162 - _xrpc_error(404, 'AppPasswordNotFound', 'No app password exists with that name') unless $row; 178 + xrpc_error(404, 'AppPasswordNotFound', 'No app password exists with that name') unless $row; 163 179 $c->store->revoke_app_password($row->{id}); 164 180 return {}; 165 181 }); 182 + 183 + $registry->register('com.atproto.server.deactivateAccount', sub ($c, $endpoint) { 184 + my (undef, $account) = require_auth($c, audience => 'access', allow_refresh => 1); 185 + $c->store->update_account($account->{did}, deactivated_at => time); 186 + return {}; 187 + }); 188 + 189 + $registry->register('com.atproto.server.activateAccount', sub ($c, $endpoint) { 190 + my (undef, $account) = require_auth($c, audience => 'access', allow_refresh => 1); 191 + $c->store->update_account($account->{did}, deactivated_at => undef); 192 + return {}; 193 + }); 194 + 195 + $registry->register('com.atproto.server.requestPasswordReset', sub ($c, $endpoint) { 196 + my $body = $c->req->json || {}; 197 + my $account = $c->store->get_account_by_email($body->{email} // q()); 198 + if ($account) { 199 + my $token = $c->store->create_action_token( 200 + did => $account->{did}, 201 + email => $account->{email}, 202 + purpose => 'password_reset', 203 + expires_at => time + 3600, 204 + ); 205 + $c->store->log_outbound_email( 206 + recipient_did => $account->{did}, 207 + recipient_email => $account->{email}, 208 + subject => 'perlds password reset', 209 + content => "Use token $token->{token} to reset your password.", 210 + ); 211 + } 212 + return {}; 213 + }); 214 + 215 + $registry->register('com.atproto.server.resetPassword', sub ($c, $endpoint) { 216 + my $body = $c->req->json || {}; 217 + xrpc_error(400, 'InvalidPassword', 'Passwords must be at least 8 characters long') 218 + if length($body->{password} // q()) < 8; 219 + my $token = _require_action_token($c, 220 + token => $body->{token}, 221 + purpose => 'password_reset', 222 + ); 223 + my $account = $c->store->get_account_by_did($token->{did}); 224 + xrpc_error(404, 'AccountNotFound', 'Account was not found') unless $account; 225 + my $password_record = hash_password($body->{password}); 226 + $c->store->txn(sub ($dbh) { 227 + $c->store->update_account( 228 + $account->{did}, 229 + password_hash => $password_record->{hash}, 230 + password_salt => $password_record->{salt}, 231 + ); 232 + $c->store->revoke_sessions_by_did($account->{did}); 233 + $c->store->revoke_app_passwords_by_did($account->{did}); 234 + $c->store->consume_action_token($token->{token}); 235 + }); 236 + return {}; 237 + }); 238 + 239 + $registry->register('com.atproto.server.requestEmailConfirmation', sub ($c, $endpoint) { 240 + my (undef, $account) = require_auth($c, audience => 'access', allow_refresh => 1); 241 + return {} unless $account->{email}; 242 + my $token = $c->store->create_action_token( 243 + did => $account->{did}, 244 + email => $account->{email}, 245 + purpose => 'email_confirm', 246 + expires_at => time + 3600, 247 + ); 248 + $c->store->log_outbound_email( 249 + recipient_did => $account->{did}, 250 + recipient_email => $account->{email}, 251 + subject => 'perlds email confirmation', 252 + content => "Use token $token->{token} to confirm your email address.", 253 + ); 254 + return {}; 255 + }); 256 + 257 + $registry->register('com.atproto.server.confirmEmail', sub ($c, $endpoint) { 258 + my $body = $c->req->json || {}; 259 + my $account = $c->store->get_account_by_email($body->{email} // q()); 260 + xrpc_error(404, 'AccountNotFound', 'Account was not found') unless $account; 261 + my $token = _require_action_token($c, 262 + token => $body->{token}, 263 + purpose => 'email_confirm', 264 + ); 265 + xrpc_error(400, 'InvalidEmail', 'Token was not issued for that email') 266 + unless ($token->{email} // q()) eq ($body->{email} // q()); 267 + $c->store->update_account($account->{did}, email_confirmed_at => time); 268 + $c->store->consume_action_token($token->{token}); 269 + return {}; 270 + }); 271 + 272 + $registry->register('com.atproto.server.requestEmailUpdate', sub ($c, $endpoint) { 273 + my (undef, $account) = require_auth($c, audience => 'access', allow_refresh => 1); 274 + my $token_required = defined $account->{email_confirmed_at} ? 1 : 0; 275 + if ($token_required) { 276 + my $token = $c->store->create_action_token( 277 + did => $account->{did}, 278 + email => $account->{email}, 279 + purpose => 'email_update', 280 + expires_at => time + 3600, 281 + ); 282 + $c->store->log_outbound_email( 283 + recipient_did => $account->{did}, 284 + recipient_email => $account->{email}, 285 + subject => 'perlds email change authorization', 286 + content => "Use token $token->{token} to update your email address.", 287 + ); 288 + } 289 + return { 290 + tokenRequired => $token_required ? JSON::PP::true : JSON::PP::false, 291 + }; 292 + }); 293 + 294 + $registry->register('com.atproto.server.updateEmail', sub ($c, $endpoint) { 295 + my (undef, $account) = require_auth($c, audience => 'access', allow_refresh => 1); 296 + my $body = $c->req->json || {}; 297 + if (defined $account->{email_confirmed_at}) { 298 + xrpc_error(400, 'TokenRequired', 'A confirmation token is required to update email') 299 + unless defined($body->{token}) && length($body->{token}); 300 + my $token = _require_action_token($c, 301 + token => $body->{token}, 302 + purpose => 'email_update', 303 + ); 304 + xrpc_error(400, 'InvalidToken', 'Token was not issued for this account') 305 + unless ($token->{did} // q()) eq $account->{did}; 306 + $c->store->consume_action_token($token->{token}); 307 + } 308 + $c->store->update_account( 309 + $account->{did}, 310 + email => $body->{email}, 311 + email_confirmed_at => undef, 312 + ); 313 + return {}; 314 + }); 315 + 316 + $registry->register('com.atproto.server.requestAccountDelete', sub ($c, $endpoint) { 317 + my (undef, $account) = require_auth($c, audience => 'access', allow_refresh => 1); 318 + my $token = $c->store->create_action_token( 319 + did => $account->{did}, 320 + email => $account->{email}, 321 + purpose => 'account_delete', 322 + expires_at => time + 3600, 323 + ); 324 + $c->store->log_outbound_email( 325 + recipient_did => $account->{did}, 326 + recipient_email => $account->{email}, 327 + subject => 'perlds account deletion', 328 + content => "Use token $token->{token} to delete your account.", 329 + ) if $account->{email}; 330 + return {}; 331 + }); 332 + 333 + $registry->register('com.atproto.server.deleteAccount', sub ($c, $endpoint) { 334 + my ($claims, $account) = require_auth($c, audience => 'access', allow_refresh => 1); 335 + my $body = $c->req->json || {}; 336 + xrpc_error(401, 'AuthRequired', 'Token is not authorized for that repo') 337 + unless ($claims->{sub} // q()) eq ($body->{did} // q()) && ($account->{did} // q()) eq ($body->{did} // q()); 338 + xrpc_error(401, 'AuthRequired', 'Invalid identifier or password') 339 + unless verify_account_password($c, $account, $body->{password} // q()); 340 + my $token = _require_action_token($c, 341 + token => $body->{token}, 342 + purpose => 'account_delete', 343 + ); 344 + xrpc_error(400, 'InvalidToken', 'Token was not issued for this account') 345 + unless ($token->{did} // q()) eq $account->{did}; 346 + $c->store->txn(sub ($dbh) { 347 + $c->store->update_account( 348 + $account->{did}, 349 + deactivated_at => time, 350 + deleted_at => time, 351 + ); 352 + $c->store->revoke_sessions_by_did($account->{did}); 353 + $c->store->revoke_app_passwords_by_did($account->{did}); 354 + $c->store->consume_action_token($token->{token}); 355 + }); 356 + return {}; 357 + }); 358 + 359 + $registry->register('com.atproto.server.getServiceAuth', sub ($c, $endpoint) { 360 + my (undef, $account) = require_auth($c, audience => 'access', allow_refresh => 1); 361 + my $requested_exp = $c->param('exp'); 362 + my $now = time; 363 + my $exp = defined($requested_exp) ? int($requested_exp) : ($now + 60); 364 + xrpc_error(400, 'BadExpiration', 'Requested expiration is out of bounds') 365 + if $exp <= $now || $exp > ($now + 3600); 366 + my $token = encode_jwt({ 367 + iss => service_did($c->app->settings), 368 + sub => $account->{did}, 369 + aud => $c->param('aud'), 370 + exp => $exp, 371 + typ => 'service', 372 + ($c->param('lxm') ? (lxm => $c->param('lxm')) : ()), 373 + }, $c->config_value('jwt_secret', 'perlds-dev-secret')); 374 + return { token => $token }; 375 + }); 376 + 377 + $registry->register('com.atproto.server.reserveSigningKey', sub ($c, $endpoint) { 378 + my $body = $c->req->json || {}; 379 + my $keys = $c->repo_manager->generate_signing_key; 380 + if ($body->{did}) { 381 + $c->store->reserve_signing_key( 382 + did => $body->{did}, 383 + private_key => $keys->{private_key}, 384 + public_key => $keys->{public_key}, 385 + public_key_multibase => $keys->{public_key_multibase}, 386 + ); 387 + } 388 + return { 389 + signingKey => 'did:key:' . $keys->{public_key_multibase}, 390 + }; 391 + }); 392 + 393 + $registry->register('com.atproto.server.createInviteCode', sub ($c, $endpoint) { 394 + my (undef, $account) = require_auth($c, audience => 'access', allow_refresh => 1); 395 + my $body = $c->req->json || {}; 396 + my $code = _new_invite_code(); 397 + $c->store->create_invite_code( 398 + code => $code, 399 + for_account => $body->{forAccount} || $account->{did}, 400 + created_by => $account->{did}, 401 + use_count => $body->{useCount} // 1, 402 + ); 403 + return { code => $code }; 404 + }); 405 + 406 + $registry->register('com.atproto.server.createInviteCodes', sub ($c, $endpoint) { 407 + my (undef, $account) = require_auth($c, audience => 'access', allow_refresh => 1); 408 + my $body = $c->req->json || {}; 409 + my @accounts = @{ $body->{forAccounts} || [ $account->{did} ] }; 410 + my $count = $body->{codeCount} // 1; 411 + my @result; 412 + for my $target (@accounts) { 413 + my @codes; 414 + for (1 .. $count) { 415 + my $code = _new_invite_code(); 416 + $c->store->create_invite_code( 417 + code => $code, 418 + for_account => $target, 419 + created_by => $account->{did}, 420 + use_count => $body->{useCount} // 1, 421 + ); 422 + push @codes, $code; 423 + } 424 + push @result, { 425 + account => $target, 426 + codes => \@codes, 427 + }; 428 + } 429 + return { codes => \@result }; 430 + }); 431 + 432 + $registry->register('com.atproto.server.getAccountInviteCodes', sub ($c, $endpoint) { 433 + my (undef, $account) = require_auth($c, audience => 'access', allow_refresh => 1); 434 + my $rows = $c->store->list_invite_codes_for_account($account->{did}); 435 + return { 436 + codes => [ map { invite_code_view($c->store, $_) } @$rows ], 437 + }; 438 + }); 166 439 } 167 440 168 - sub issue_session ($c, $account) { 441 + sub session_view ($account) { 442 + return { 443 + handle => $account->{handle}, 444 + did => $account->{did}, 445 + didDoc => $account->{did_doc} || account_did_doc({}, $account), 446 + email => $account->{email}, 447 + emailConfirmed => defined($account->{email_confirmed_at}) ? JSON::PP::true : JSON::PP::false, 448 + emailAuthFactor => JSON::PP::false, 449 + active => (!defined($account->{deactivated_at}) && !defined($account->{deleted_at})) 450 + ? JSON::PP::true 451 + : JSON::PP::false, 452 + (defined($account->{deleted_at}) ? (status => 'deleted') : ()), 453 + (defined($account->{deactivated_at}) && !defined($account->{deleted_at}) ? (status => 'deactivated') : ()), 454 + }; 455 + } 456 + 457 + sub require_auth ($c, %opts) { 458 + my $auth = $c->req->headers->authorization // q(); 459 + xrpc_error(401, 'AuthRequired', 'Authorization header is required') 460 + unless $auth =~ /\ABearer\s+(.+)\z/i; 461 + my $token = $1; 462 + 463 + my $decoded = eval { decode_jwt($token, $c->config_value('jwt_secret', 'perlds-dev-secret')) }; 464 + if (my $err = $@) { 465 + my $message = "$err"; 466 + my $code = $message =~ /expired/i ? 'ExpiredToken' : 'InvalidToken'; 467 + xrpc_error(401, $code, $message); 468 + } 469 + 470 + my $claims = $decoded->{claims}; 471 + my $aud = $claims->{aud} // q(); 472 + my $ok = $aud eq ($opts{audience} // 'access') 473 + || ($opts{allow_refresh} && $aud eq 'refresh'); 474 + xrpc_error(401, 'InvalidToken', 'Unexpected token audience') unless $ok; 475 + 476 + my $account = $c->store->get_account_by_did($claims->{sub}); 477 + xrpc_error(401, 'InvalidToken', 'Token subject no longer exists') unless $account; 478 + xrpc_error(401, 'InvalidToken', 'Token subject has been deleted') if defined $account->{deleted_at}; 479 + return ($claims, $account); 480 + } 481 + 482 + sub _issue_session ($c, $account) { 169 483 my $session = $c->store->create_session( 170 484 did => $account->{did}, 171 485 expires_at => time + (30 * 24 * 60 * 60), ··· 200 514 }; 201 515 } 202 516 203 - sub session_view ($account) { 204 - return { 205 - handle => $account->{handle}, 206 - did => $account->{did}, 207 - didDoc => $account->{did_doc} || account_did_doc({}, $account), 208 - email => $account->{email}, 209 - emailConfirmed => $account->{email} ? true : false, 210 - emailAuthFactor => false, 211 - active => !defined($account->{deactivated_at}) ? true : false, 212 - (defined($account->{deactivated_at}) ? (status => 'deactivated') : ()), 213 - }; 214 - } 215 - 216 - sub require_auth ($c, %opts) { 217 - my $auth = $c->req->headers->authorization // ''; 218 - _xrpc_error(401, 'AuthRequired', 'Authorization header is required') unless $auth =~ /\ABearer\s+(.+)\z/i; 219 - my $token = $1; 220 - 221 - my $decoded = eval { decode_jwt($token, $c->config_value('jwt_secret', 'perlds-dev-secret')) }; 222 - if (my $err = $@) { 223 - my $message = "$err"; 224 - my $code = $message =~ /expired/i ? 'ExpiredToken' : 'InvalidToken'; 225 - _xrpc_error(401, $code, $message); 226 - } 227 - 228 - my $claims = $decoded->{claims}; 229 - my $aud = $claims->{aud} // q(); 230 - my $ok = $aud eq ($opts{audience} // 'access') 231 - || ($opts{allow_refresh} && $aud eq 'refresh'); 232 - _xrpc_error(401, 'InvalidToken', 'Unexpected token audience') unless $ok; 233 - 234 - my $account = $c->store->get_account_by_did($claims->{sub}); 235 - _xrpc_error(401, 'InvalidToken', 'Token subject no longer exists') unless $account; 236 - return ($claims, $account); 237 - } 238 - 239 - sub _find_account ($c, $identifier) { 240 - return undef unless defined $identifier && length $identifier; 241 - my $account = $c->store->get_account_by_identifier($identifier); 242 - return $account if $account; 243 - return $c->store->get_account_by_email($identifier); 244 - } 245 - 246 - sub _xrpc_error ($status, $error, $message) { 247 - die { 248 - status => $status, 249 - error => $error, 250 - message => $message, 251 - }; 517 + sub _require_action_token ($c, %args) { 518 + xrpc_error(400, 'InvalidToken', 'Token is required') 519 + unless defined($args{token}) && length($args{token}); 520 + my $token = $c->store->get_action_token($args{token}); 521 + xrpc_error(400, 'InvalidToken', 'Token was not found') unless $token; 522 + xrpc_error(400, 'InvalidToken', 'Token purpose did not match') 523 + unless ($token->{purpose} // q()) eq ($args{purpose} // q()); 524 + xrpc_error(400, 'InvalidToken', 'Token has already been used') if defined $token->{consumed_at}; 525 + xrpc_error(400, 'ExpiredToken', 'Token has expired') 526 + if defined($token->{expires_at}) && $token->{expires_at} < time; 527 + return $token; 252 528 } 253 529 254 530 sub _new_app_password { 255 531 return join('-', map { substr(random_hex(4), 0, 4) } 1 .. 4); 256 532 } 257 533 258 - sub _iso8601 ($epoch) { 259 - my @gmt = gmtime($epoch // time); 260 - return sprintf( 261 - '%04d-%02d-%02dT%02d:%02d:%02dZ', 262 - $gmt[5] + 1900, 263 - $gmt[4] + 1, 264 - $gmt[3], 265 - $gmt[2], 266 - $gmt[1], 267 - $gmt[0], 268 - ); 534 + sub _new_invite_code { 535 + return 'perlds-' . substr(random_hex(8), 0, 12); 269 536 } 270 537 271 538 1;
+594 -3
lib/ATProto/PDS/Store/SQLite.pm
··· 105 105 q{ 106 106 INSERT INTO accounts ( 107 107 id, account_id, did, handle, email, password_hash, password_salt, 108 - created_at, updated_at, deactivated_at, deleted_at, 108 + created_at, updated_at, deactivated_at, deleted_at, email_confirmed_at, 109 109 did_doc_json, private_key, public_key, public_key_multibase, 110 - repo_commit_cid, repo_root_cid, repo_rev 111 - ) VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?) 110 + repo_commit_cid, repo_root_cid, repo_rev, invites_disabled, invite_note 111 + ) VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?) 112 112 }, 113 113 undef, 114 114 $account_id, ··· 122 122 $now, 123 123 $args{deactivated_at}, 124 124 $args{deleted_at}, 125 + $args{email_confirmed_at}, 125 126 _maybe_json($args{did_doc}), 126 127 $args{private_key}, 127 128 $args{public_key}, ··· 129 130 $args{repo_commit_cid}, 130 131 $args{repo_root_cid}, 131 132 $args{repo_rev}, 133 + $args{invites_disabled} ? 1 : 0, 134 + $args{invite_note}, 132 135 ); 133 136 134 137 return $self->get_account_by_did($did); ··· 137 140 sub update_account ($self, $did, %changes) { 138 141 my %allowed = map { $_ => 1 } qw( 139 142 handle email password_hash password_salt updated_at deactivated_at deleted_at 143 + email_confirmed_at invites_disabled invite_note 140 144 did_doc private_key public_key public_key_multibase 141 145 repo_commit_cid repo_root_cid repo_rev 142 146 ); ··· 329 333 ); 330 334 } 331 335 336 + sub revoke_app_passwords_by_did ($self, $did, %args) { 337 + $self->dbh->do( 338 + q{UPDATE app_passwords SET revoked_at = ? WHERE did = ? AND revoked_at IS NULL}, 339 + undef, 340 + $args{revoked_at} // time, 341 + $did, 342 + ); 343 + return $self->list_app_passwords_by_did($did); 344 + } 345 + 332 346 sub put_blob ($self, %args) { 333 347 my $cid = $args{cid} // die 'cid is required'; 334 348 my $now = $args{created_at} // time; ··· 382 396 push @bind, $limit + 1; 383 397 my $rows = $self->dbh->selectall_arrayref($sql, { Slice => {} }, @bind); 384 398 return _paginate($rows, $limit, 'cid'); 399 + } 400 + 401 + sub count_blobs_by_did ($self, $did) { 402 + return $self->dbh->selectrow_array( 403 + q{SELECT COUNT(*) FROM blobs WHERE did = ?}, 404 + undef, 405 + $did, 406 + ) // 0; 385 407 } 386 408 387 409 sub put_record ($self, %args) { ··· 506 528 return [ map { $_->{collection} } @$rows ]; 507 529 } 508 530 531 + sub count_records_by_did ($self, $did) { 532 + return $self->dbh->selectrow_array( 533 + q{SELECT COUNT(*) FROM records WHERE did = ?}, 534 + undef, 535 + $did, 536 + ) // 0; 537 + } 538 + 509 539 sub put_block ($self, %args) { 510 540 my $cid = $args{cid} // die 'cid is required'; 511 541 my $now = $args{created_at} // time; ··· 628 658 return $page; 629 659 } 630 660 661 + sub list_repos_by_collection ($self, $collection, %args) { 662 + my $limit = $args{limit} // 500; 663 + $limit = 2000 if $limit > 2000; 664 + my $cursor = $args{cursor}; 665 + my @bind = ($collection); 666 + my $sql = q{ 667 + SELECT DISTINCT did 668 + FROM records 669 + WHERE collection = ? 670 + }; 671 + if (defined $cursor && length $cursor) { 672 + $sql .= q{ AND did > ?}; 673 + push @bind, $cursor; 674 + } 675 + $sql .= q{ ORDER BY did LIMIT ?}; 676 + push @bind, $limit + 1; 677 + my $rows = $self->dbh->selectall_arrayref($sql, { Slice => {} }, @bind); 678 + return _paginate($rows, $limit, 'did'); 679 + } 680 + 681 + sub search_accounts ($self, %args) { 682 + my $limit = $args{limit} // 50; 683 + $limit = 100 if $limit > 100; 684 + my $cursor = $args{cursor}; 685 + my $email = $args{email}; 686 + my @bind; 687 + my @where; 688 + if (defined $email && length $email) { 689 + push @where, q{email LIKE ?}; 690 + push @bind, '%' . $email . '%'; 691 + } 692 + if (defined $cursor && length $cursor) { 693 + push @where, q{did > ?}; 694 + push @bind, $cursor; 695 + } 696 + my $sql = q{SELECT * FROM accounts}; 697 + $sql .= q{ WHERE } . join(q{ AND }, @where) if @where; 698 + $sql .= q{ ORDER BY did LIMIT ?}; 699 + push @bind, $limit + 1; 700 + my $rows = $self->dbh->selectall_arrayref($sql, { Slice => {} }, @bind); 701 + my $page = _paginate($rows, $limit, 'did'); 702 + $page->{items} = [ map { $self->_row_to_account($_) } @{ $page->{items} } ]; 703 + return $page; 704 + } 705 + 631 706 sub append_event ($self, %args) { 632 707 my $now = $args{created_at} // time; 633 708 $self->dbh->do( ··· 654 729 return $self->dbh->selectall_arrayref($sql, { Slice => {} }, $cursor // 0, $limit); 655 730 } 656 731 732 + sub create_action_token ($self, %args) { 733 + my $token = $args{token} // _random_id(); 734 + my $purpose = $args{purpose} // die 'purpose is required'; 735 + my $now = $args{created_at} // time; 736 + $self->dbh->do( 737 + q{ 738 + INSERT INTO action_tokens ( 739 + token, did, email, purpose, payload_json, created_at, expires_at, consumed_at 740 + ) VALUES (?, ?, ?, ?, ?, ?, ?, ?) 741 + }, 742 + undef, 743 + $token, 744 + $args{did}, 745 + $args{email}, 746 + $purpose, 747 + _maybe_json($args{payload}), 748 + $now, 749 + $args{expires_at}, 750 + $args{consumed_at}, 751 + ); 752 + return $self->get_action_token($token); 753 + } 754 + 755 + sub get_action_token ($self, $token) { 756 + my $row = $self->dbh->selectrow_hashref( 757 + q{SELECT * FROM action_tokens WHERE token = ?}, 758 + undef, 759 + $token, 760 + ); 761 + return _row_from_json_columns($row, qw(payload_json)); 762 + } 763 + 764 + sub consume_action_token ($self, $token, %args) { 765 + $self->dbh->do( 766 + q{UPDATE action_tokens SET consumed_at = ? WHERE token = ?}, 767 + undef, 768 + $args{consumed_at} // time, 769 + $token, 770 + ); 771 + return $self->get_action_token($token); 772 + } 773 + 774 + sub latest_action_token ($self, %args) { 775 + my @where; 776 + my @bind; 777 + for my $pair ( 778 + [ purpose => 'purpose' ], 779 + [ did => 'did' ], 780 + [ email => 'email' ], 781 + ) { 782 + my ($arg, $column) = @$pair; 783 + next unless defined $args{$arg}; 784 + push @where, "$column = ?"; 785 + push @bind, $args{$arg}; 786 + } 787 + my $sql = q{SELECT * FROM action_tokens}; 788 + $sql .= q{ WHERE } . join(q{ AND }, @where) if @where; 789 + $sql .= q{ ORDER BY created_at DESC, token DESC LIMIT 1}; 790 + my $row = $self->dbh->selectrow_hashref($sql, undef, @bind); 791 + return _row_from_json_columns($row, qw(payload_json)); 792 + } 793 + 794 + sub create_invite_code ($self, %args) { 795 + my $code = $args{code} // die 'code is required'; 796 + my $now = $args{created_at} // time; 797 + $self->dbh->do( 798 + q{ 799 + INSERT INTO invite_codes ( 800 + code, for_account, created_by, use_count, disabled, note, created_at 801 + ) VALUES (?, ?, ?, ?, ?, ?, ?) 802 + }, 803 + undef, 804 + $code, 805 + $args{for_account}, 806 + $args{created_by}, 807 + $args{use_count} // 1, 808 + $args{disabled} ? 1 : 0, 809 + $args{note}, 810 + $now, 811 + ); 812 + return $self->get_invite_code($code); 813 + } 814 + 815 + sub get_invite_code ($self, $code) { 816 + my $row = $self->dbh->selectrow_hashref( 817 + q{SELECT * FROM invite_codes WHERE code = ?}, 818 + undef, 819 + $code, 820 + ); 821 + return undef unless $row; 822 + my $uses = $self->dbh->selectrow_array( 823 + q{SELECT COUNT(*) FROM invite_code_uses WHERE code = ?}, 824 + undef, 825 + $code, 826 + ) // 0; 827 + $row->{use_count_consumed} = $uses; 828 + return $row; 829 + } 830 + 831 + sub list_invite_codes ($self, %args) { 832 + my $limit = $args{limit} // 100; 833 + $limit = 500 if $limit > 500; 834 + my $cursor = $args{cursor}; 835 + my @bind; 836 + my $sql = q{SELECT * FROM invite_codes}; 837 + if (defined $cursor && length $cursor) { 838 + $sql .= q{ WHERE code > ?}; 839 + push @bind, $cursor; 840 + } 841 + if (($args{sort} // 'recent') eq 'usage') { 842 + $sql .= defined($cursor) && length($cursor) 843 + ? q{ ORDER BY use_count DESC, code ASC} 844 + : q{ ORDER BY use_count DESC, code ASC}; 845 + } else { 846 + $sql .= q{ ORDER BY created_at DESC, code DESC}; 847 + } 848 + $sql .= q{ LIMIT ?}; 849 + push @bind, $limit + 1; 850 + my $rows = $self->dbh->selectall_arrayref($sql, { Slice => {} }, @bind); 851 + my $page = _paginate($rows, $limit, 'code'); 852 + $page->{items} = [ map { $self->get_invite_code($_->{code}) } @{ $page->{items} } ]; 853 + return $page; 854 + } 855 + 856 + sub list_invite_codes_for_account ($self, $did) { 857 + my $rows = $self->dbh->selectall_arrayref( 858 + q{SELECT * FROM invite_codes WHERE for_account = ? ORDER BY created_at DESC, code DESC}, 859 + { Slice => {} }, 860 + $did, 861 + ); 862 + return [ map { $self->get_invite_code($_->{code}) } @$rows ]; 863 + } 864 + 865 + sub record_invite_code_use ($self, %args) { 866 + my $code = $args{code} // die 'code is required'; 867 + my $used_by = $args{used_by} // die 'used_by is required'; 868 + my $used_at = $args{used_at} // time; 869 + $self->dbh->do( 870 + q{ 871 + INSERT INTO invite_code_uses (code, used_by, used_at) 872 + VALUES (?, ?, ?) 873 + ON CONFLICT(code, used_by) DO UPDATE SET 874 + used_at = excluded.used_at 875 + }, 876 + undef, 877 + $code, 878 + $used_by, 879 + $used_at, 880 + ); 881 + return $self->list_invite_code_uses($code); 882 + } 883 + 884 + sub list_invite_code_uses ($self, $code) { 885 + return $self->dbh->selectall_arrayref( 886 + q{SELECT * FROM invite_code_uses WHERE code = ? ORDER BY used_at ASC, used_by ASC}, 887 + { Slice => {} }, 888 + $code, 889 + ); 890 + } 891 + 892 + sub disable_invite_codes ($self, %args) { 893 + my $now = $args{updated_at} // time; 894 + if (my $codes = $args{codes}) { 895 + return [] unless @$codes; 896 + my $placeholders = join(', ', ('?') x @$codes); 897 + $self->dbh->do( 898 + "UPDATE invite_codes SET disabled = 1, note = COALESCE(?, note) WHERE code IN ($placeholders)", 899 + undef, 900 + $args{note}, 901 + @$codes, 902 + ); 903 + } 904 + if (my $accounts = $args{accounts}) { 905 + return [] unless @$accounts; 906 + my $placeholders = join(', ', ('?') x @$accounts); 907 + $self->dbh->do( 908 + "UPDATE invite_codes SET disabled = 1, note = COALESCE(?, note) WHERE for_account IN ($placeholders)", 909 + undef, 910 + $args{note}, 911 + @$accounts, 912 + ); 913 + } 914 + return $now; 915 + } 916 + 917 + sub create_report ($self, %args) { 918 + my $now = $args{created_at} // time; 919 + $self->dbh->do( 920 + q{ 921 + INSERT INTO moderation_reports ( 922 + reason_type, reason, subject_json, reported_by, mod_tool_json, created_at 923 + ) VALUES (?, ?, ?, ?, ?, ?) 924 + }, 925 + undef, 926 + $args{reason_type}, 927 + $args{reason}, 928 + _maybe_json($args{subject}), 929 + $args{reported_by}, 930 + _maybe_json($args{mod_tool}), 931 + $now, 932 + ); 933 + my $id = $self->dbh->sqlite_last_insert_rowid; 934 + return $self->get_report($id); 935 + } 936 + 937 + sub get_report ($self, $id) { 938 + my $row = $self->dbh->selectrow_hashref( 939 + q{SELECT * FROM moderation_reports WHERE id = ?}, 940 + undef, 941 + $id, 942 + ); 943 + return _row_from_json_columns($row, qw(subject_json mod_tool_json)); 944 + } 945 + 946 + sub put_subject_status ($self, %args) { 947 + my $subject_key = $args{subject_key} // die 'subject_key is required'; 948 + my $now = $args{updated_at} // time; 949 + $self->dbh->do( 950 + q{ 951 + INSERT INTO subject_statuses ( 952 + subject_key, subject_json, takedown_json, deactivated_json, updated_at 953 + ) VALUES (?, ?, ?, ?, ?) 954 + ON CONFLICT(subject_key) DO UPDATE SET 955 + subject_json = excluded.subject_json, 956 + takedown_json = excluded.takedown_json, 957 + deactivated_json = excluded.deactivated_json, 958 + updated_at = excluded.updated_at 959 + }, 960 + undef, 961 + $subject_key, 962 + _maybe_json($args{subject}), 963 + _maybe_json($args{takedown}), 964 + _maybe_json($args{deactivated}), 965 + $now, 966 + ); 967 + return $self->get_subject_status($subject_key); 968 + } 969 + 970 + sub get_subject_status ($self, $subject_key) { 971 + my $row = $self->dbh->selectrow_hashref( 972 + q{SELECT * FROM subject_statuses WHERE subject_key = ?}, 973 + undef, 974 + $subject_key, 975 + ); 976 + return _row_from_json_columns($row, qw(subject_json takedown_json deactivated_json)); 977 + } 978 + 979 + sub list_subject_statuses ($self) { 980 + my $rows = $self->dbh->selectall_arrayref( 981 + q{SELECT * FROM subject_statuses ORDER BY updated_at DESC, subject_key ASC}, 982 + { Slice => {} }, 983 + ); 984 + return [ map { _row_from_json_columns($_, qw(subject_json takedown_json deactivated_json)) } @$rows ]; 985 + } 986 + 987 + sub reserve_signing_key ($self, %args) { 988 + my $did = $args{did} // die 'did is required'; 989 + my $now = $args{created_at} // time; 990 + $self->dbh->do( 991 + q{ 992 + INSERT INTO reserved_signing_keys ( 993 + did, private_key, public_key, public_key_multibase, created_at, claimed_at 994 + ) VALUES (?, ?, ?, ?, ?, ?) 995 + ON CONFLICT(did) DO UPDATE SET 996 + private_key = excluded.private_key, 997 + public_key = excluded.public_key, 998 + public_key_multibase = excluded.public_key_multibase, 999 + created_at = excluded.created_at, 1000 + claimed_at = excluded.claimed_at 1001 + }, 1002 + undef, 1003 + $did, 1004 + $args{private_key}, 1005 + $args{public_key}, 1006 + $args{public_key_multibase}, 1007 + $now, 1008 + $args{claimed_at}, 1009 + ); 1010 + return $self->get_reserved_signing_key($did); 1011 + } 1012 + 1013 + sub get_reserved_signing_key ($self, $did) { 1014 + return $self->dbh->selectrow_hashref( 1015 + q{SELECT * FROM reserved_signing_keys WHERE did = ?}, 1016 + undef, 1017 + $did, 1018 + ); 1019 + } 1020 + 1021 + sub claim_reserved_signing_key ($self, $did, %args) { 1022 + $self->dbh->do( 1023 + q{UPDATE reserved_signing_keys SET claimed_at = ? WHERE did = ?}, 1024 + undef, 1025 + $args{claimed_at} // time, 1026 + $did, 1027 + ); 1028 + return $self->get_reserved_signing_key($did); 1029 + } 1030 + 1031 + sub reserve_handle ($self, $handle, %args) { 1032 + my $now = $args{created_at} // time; 1033 + $self->dbh->do( 1034 + q{ 1035 + INSERT INTO reserved_handles (handle, note, created_at) 1036 + VALUES (?, ?, ?) 1037 + ON CONFLICT(handle) DO UPDATE SET 1038 + note = excluded.note 1039 + }, 1040 + undef, 1041 + $handle, 1042 + $args{note}, 1043 + $now, 1044 + ); 1045 + return $self->get_reserved_handle($handle); 1046 + } 1047 + 1048 + sub get_reserved_handle ($self, $handle) { 1049 + return $self->dbh->selectrow_hashref( 1050 + q{SELECT * FROM reserved_handles WHERE handle = ?}, 1051 + undef, 1052 + $handle, 1053 + ); 1054 + } 1055 + 1056 + sub list_reserved_handles ($self) { 1057 + return $self->dbh->selectall_arrayref( 1058 + q{SELECT * FROM reserved_handles ORDER BY handle}, 1059 + { Slice => {} }, 1060 + ); 1061 + } 1062 + 1063 + sub log_outbound_email ($self, %args) { 1064 + my $now = $args{created_at} // time; 1065 + $self->dbh->do( 1066 + q{ 1067 + INSERT INTO outbound_emails ( 1068 + recipient_did, recipient_email, sender_did, subject, content, comment, sent, created_at 1069 + ) VALUES (?, ?, ?, ?, ?, ?, ?, ?) 1070 + }, 1071 + undef, 1072 + $args{recipient_did}, 1073 + $args{recipient_email}, 1074 + $args{sender_did}, 1075 + $args{subject}, 1076 + $args{content}, 1077 + $args{comment}, 1078 + $args{sent} ? 1 : 0, 1079 + $now, 1080 + ); 1081 + return $self->dbh->sqlite_last_insert_rowid; 1082 + } 1083 + 1084 + sub touch_host_notice ($self, %args) { 1085 + my $hostname = $args{hostname} // die 'hostname is required'; 1086 + my $now = time; 1087 + my $requested_at = $args{requested_at}; 1088 + my $notified_at = $args{notified_at}; 1089 + $self->dbh->do( 1090 + q{ 1091 + INSERT INTO crawl_hosts ( 1092 + hostname, requested_at, notified_at, last_seq, status_json 1093 + ) VALUES (?, ?, ?, ?, ?) 1094 + ON CONFLICT(hostname) DO UPDATE SET 1095 + requested_at = COALESCE(excluded.requested_at, crawl_hosts.requested_at), 1096 + notified_at = COALESCE(excluded.notified_at, crawl_hosts.notified_at), 1097 + last_seq = COALESCE(excluded.last_seq, crawl_hosts.last_seq), 1098 + status_json = COALESCE(excluded.status_json, crawl_hosts.status_json) 1099 + }, 1100 + undef, 1101 + $hostname, 1102 + $requested_at, 1103 + $notified_at, 1104 + $args{last_seq}, 1105 + _maybe_json($args{status}), 1106 + ); 1107 + return $now && $self->get_host_notice($hostname); 1108 + } 1109 + 1110 + sub get_host_notice ($self, $hostname) { 1111 + my $row = $self->dbh->selectrow_hashref( 1112 + q{SELECT * FROM crawl_hosts WHERE hostname = ?}, 1113 + undef, 1114 + $hostname, 1115 + ); 1116 + return _row_from_json_columns($row, qw(status_json)); 1117 + } 1118 + 1119 + sub list_host_notices ($self, %args) { 1120 + my $limit = $args{limit} // 200; 1121 + $limit = 1000 if $limit > 1000; 1122 + my $cursor = $args{cursor}; 1123 + my @bind; 1124 + my $sql = q{SELECT * FROM crawl_hosts}; 1125 + if (defined $cursor && length $cursor) { 1126 + $sql .= q{ WHERE hostname > ?}; 1127 + push @bind, $cursor; 1128 + } 1129 + $sql .= q{ ORDER BY hostname LIMIT ?}; 1130 + push @bind, $limit + 1; 1131 + my $rows = $self->dbh->selectall_arrayref($sql, { Slice => {} }, @bind); 1132 + my $page = _paginate($rows, $limit, 'hostname'); 1133 + $page->{items} = [ map { _row_from_json_columns($_, qw(status_json)) } @{ $page->{items} } ]; 1134 + return $page; 1135 + } 1136 + 657 1137 sub set_repo_head ($self, %args) { 658 1138 my $did = $args{did} // die 'did is required'; 659 1139 my $now = $args{indexed_at} // time; ··· 837 1317 q{CREATE INDEX IF NOT EXISTS events_seq_idx ON events(seq)}, 838 1318 ], 839 1319 }, 1320 + { 1321 + version => 3, 1322 + statements => [ 1323 + q{ALTER TABLE accounts ADD COLUMN email_confirmed_at INTEGER}, 1324 + q{ALTER TABLE accounts ADD COLUMN invites_disabled INTEGER NOT NULL DEFAULT 0}, 1325 + q{ALTER TABLE accounts ADD COLUMN invite_note TEXT}, 1326 + q{ 1327 + CREATE TABLE IF NOT EXISTS action_tokens ( 1328 + token TEXT PRIMARY KEY, 1329 + did TEXT, 1330 + email TEXT, 1331 + purpose TEXT NOT NULL, 1332 + payload_json TEXT, 1333 + created_at INTEGER NOT NULL, 1334 + expires_at INTEGER, 1335 + consumed_at INTEGER 1336 + ) 1337 + }, 1338 + q{CREATE INDEX IF NOT EXISTS action_tokens_lookup_idx ON action_tokens (purpose, did, email, created_at DESC)}, 1339 + q{ 1340 + CREATE TABLE IF NOT EXISTS reserved_signing_keys ( 1341 + did TEXT PRIMARY KEY, 1342 + private_key BLOB NOT NULL, 1343 + public_key BLOB NOT NULL, 1344 + public_key_multibase TEXT NOT NULL, 1345 + created_at INTEGER NOT NULL, 1346 + claimed_at INTEGER 1347 + ) 1348 + }, 1349 + q{ 1350 + CREATE TABLE IF NOT EXISTS reserved_handles ( 1351 + handle TEXT PRIMARY KEY, 1352 + note TEXT, 1353 + created_at INTEGER NOT NULL 1354 + ) 1355 + }, 1356 + q{ 1357 + CREATE TABLE IF NOT EXISTS invite_codes ( 1358 + code TEXT PRIMARY KEY, 1359 + for_account TEXT, 1360 + created_by TEXT, 1361 + use_count INTEGER NOT NULL DEFAULT 1, 1362 + disabled INTEGER NOT NULL DEFAULT 0, 1363 + note TEXT, 1364 + created_at INTEGER NOT NULL 1365 + ) 1366 + }, 1367 + q{CREATE INDEX IF NOT EXISTS invite_codes_for_account_idx ON invite_codes (for_account, created_at DESC)}, 1368 + q{ 1369 + CREATE TABLE IF NOT EXISTS invite_code_uses ( 1370 + code TEXT NOT NULL, 1371 + used_by TEXT NOT NULL, 1372 + used_at INTEGER NOT NULL, 1373 + PRIMARY KEY (code, used_by) 1374 + ) 1375 + }, 1376 + q{ 1377 + CREATE TABLE IF NOT EXISTS moderation_reports ( 1378 + id INTEGER PRIMARY KEY AUTOINCREMENT, 1379 + reason_type TEXT NOT NULL, 1380 + reason TEXT, 1381 + subject_json TEXT NOT NULL, 1382 + reported_by TEXT NOT NULL, 1383 + mod_tool_json TEXT, 1384 + created_at INTEGER NOT NULL 1385 + ) 1386 + }, 1387 + q{ 1388 + CREATE TABLE IF NOT EXISTS subject_statuses ( 1389 + subject_key TEXT PRIMARY KEY, 1390 + subject_json TEXT NOT NULL, 1391 + takedown_json TEXT, 1392 + deactivated_json TEXT, 1393 + updated_at INTEGER NOT NULL 1394 + ) 1395 + }, 1396 + q{ 1397 + CREATE TABLE IF NOT EXISTS outbound_emails ( 1398 + id INTEGER PRIMARY KEY AUTOINCREMENT, 1399 + recipient_did TEXT, 1400 + recipient_email TEXT, 1401 + sender_did TEXT, 1402 + subject TEXT, 1403 + content TEXT NOT NULL, 1404 + comment TEXT, 1405 + sent INTEGER NOT NULL DEFAULT 1, 1406 + created_at INTEGER NOT NULL 1407 + ) 1408 + }, 1409 + q{ 1410 + CREATE TABLE IF NOT EXISTS crawl_hosts ( 1411 + hostname TEXT PRIMARY KEY, 1412 + requested_at INTEGER, 1413 + notified_at INTEGER, 1414 + last_seq INTEGER, 1415 + status_json TEXT 1416 + ) 1417 + }, 1418 + ], 1419 + }, 840 1420 ); 841 1421 } 842 1422 ··· 866 1446 } 867 1447 delete $row->{did_doc_json}; 868 1448 $row->{account_id} //= $row->{id}; 1449 + return $row; 1450 + } 1451 + 1452 + sub _row_from_json_columns ($row, @columns) { 1453 + return undef unless $row; 1454 + for my $column (@columns) { 1455 + next unless defined $row->{$column} && length $row->{$column}; 1456 + (my $target = $column) =~ s/_json$//; 1457 + $row->{$target} = decode_json($row->{$column}); 1458 + delete $row->{$column}; 1459 + } 869 1460 return $row; 870 1461 } 871 1462