perlsky is a Perl 5 implementation of an AT Protocol Personal Data Server.
Expand account lifecycle and admin API coverage
+1652
-127
+4
lib/ATProto/PDS.pm
+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
+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
+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
+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
+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
+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