perlsky is a Perl 5 implementation of an AT Protocol Personal Data Server.
Deduplicate API helper plumbing
+222
-39
+5
-12
lib/ATProto/PDS/API/Admin.pm
+5
-12
lib/ATProto/PDS/API/Admin.pm
···
9
9
use JSON::PP ();
10
10
11
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);
12
+
use ATProto::PDS::API::Util qw(flatten_params xrpc_error);
13
13
use ATProto::PDS::Auth::Password qw(hash_password);
14
14
use ATProto::PDS::Crypto::Secp256k1 qw(signing_did_to_public_key_multibase);
15
15
use ATProto::PDS::Identity qw(account_did_doc normalize_handle service_did);
···
27
27
28
28
$registry->register('com.atproto.admin.getAccountInfos', sub ($c, $endpoint) {
29
29
require_admin($c);
30
-
my @dids = _flatten_params($c->every_param('dids'));
30
+
my @dids = flatten_params($c->every_param('dids'));
31
31
return {
32
32
infos => [
33
33
map { account_view($_) }
···
66
66
require_admin($c);
67
67
my $body = $c->req->json || {};
68
68
my $subject = _validated_subject($c, $body->{subject} || {});
69
-
my $existing = $c->store->get_subject_status(subject_key($subject));
69
+
my $subject_key = subject_key($subject);
70
+
my $existing = $c->store->get_subject_status($subject_key);
70
71
my $status = $c->store->put_subject_status(
71
-
subject_key => subject_key($subject),
72
+
subject_key => $subject_key,
72
73
subject => $subject,
73
74
takedown => exists($body->{takedown}) ? $body->{takedown} : ($existing ? $existing->{takedown} : undef),
74
75
deactivated => exists($body->{deactivated}) ? $body->{deactivated} : ($existing ? $existing->{deactivated} : undef),
···
253
254
);
254
255
return {};
255
256
});
256
-
}
257
-
258
-
sub _flatten_params (@values) {
259
-
my @flat;
260
-
for my $value (@values) {
261
-
push @flat, ref($value) eq 'ARRAY' ? @$value : $value;
262
-
}
263
-
return @flat;
264
257
}
265
258
266
259
sub _subject_from_params ($c) {
+2
-10
lib/ATProto/PDS/API/Sync.pm
+2
-10
lib/ATProto/PDS/API/Sync.pm
···
10
10
use Mojo::IOLoop;
11
11
12
12
use ATProto::PDS::EventStream qw(encode_error_frame encode_info_frame encode_message_frame);
13
-
use ATProto::PDS::API::Util qw(iso8601 resolve_did_account xrpc_error);
13
+
use ATProto::PDS::API::Util qw(flatten_params iso8601 resolve_did_account xrpc_error);
14
14
use ATProto::PDS::Identity qw(service_host);
15
15
use ATProto::PDS::Moderation qw(assert_blob_readable assert_record_readable assert_repo_readable);
16
16
use ATProto::PDS::Repo::CAR qw(write_car);
···
96
96
my $account = resolve_did_account($c, $c->param('did') // q());
97
97
xrpc_error(404, 'RepoNotFound', 'Repository was not found') unless $account;
98
98
assert_repo_readable($c, $account, message => 'Could not find repo for DID: ' . ($c->param('did') // q()));
99
-
my @cids = _flatten_params($c->every_param('cids'));
99
+
my @cids = flatten_params($c->every_param('cids'));
100
100
xrpc_error(400, 'InvalidRequest', 'At least one CID is required') unless @cids;
101
101
my $rows = $c->store->get_blocks(\@cids);
102
102
my %found = map { $_->{cid} => $_ } @$rows;
···
279
279
});
280
280
return;
281
281
});
282
-
}
283
-
284
-
sub _flatten_params (@values) {
285
-
my @flat;
286
-
for my $value (@values) {
287
-
push @flat, ref($value) eq 'ARRAY' ? @$value : $value;
288
-
}
289
-
return @flat;
290
282
}
291
283
292
284
sub _host_view ($c, $row) {
+9
-11
lib/ATProto/PDS/API/Util.pm
+9
-11
lib/ATProto/PDS/API/Util.pm
···
10
10
11
11
our @EXPORT_OK = qw(
12
12
blob_ref
13
+
flatten_params
13
14
iso8601
14
15
resolve_did_account
15
16
resolve_repo
16
-
subject_key
17
17
xrpc_error
18
18
);
19
19
···
23
23
error => $error,
24
24
message => $message,
25
25
};
26
+
}
27
+
28
+
sub flatten_params (@values) {
29
+
my @flat;
30
+
for my $value (@values) {
31
+
push @flat, ref($value) eq 'ARRAY' ? @$value : $value;
32
+
}
33
+
return @flat;
26
34
}
27
35
28
36
sub iso8601 ($epoch = undef) {
···
55
63
return undef unless defined $repo && length $repo;
56
64
return $c->store->get_account_by_handle($repo) unless $repo =~ /\Adid:/;
57
65
return resolve_did_account($c, $repo);
58
-
}
59
-
60
-
sub subject_key ($subject) {
61
-
return 'blob:' . ($subject->{did} // q()) . ':' . ($subject->{cid} // q())
62
-
if ref($subject) eq 'HASH' && exists $subject->{cid} && exists $subject->{did} && !exists $subject->{uri};
63
-
return 'uri:' . ($subject->{uri} // q())
64
-
if ref($subject) eq 'HASH' && exists $subject->{uri};
65
-
return 'repo:' . ($subject->{did} // q())
66
-
if ref($subject) eq 'HASH' && exists $subject->{did};
67
-
return 'unknown';
68
66
}
69
67
70
68
sub blob_ref ($cid, $mime_type, $size) {
+8
-6
lib/ATProto/PDS/ServiceProxy.pm
+8
-6
lib/ATProto/PDS/ServiceProxy.pm
···
77
77
78
78
my $auth = $c->req->headers->authorization;
79
79
if (defined $auth && length $auth) {
80
-
my (undef, $account) = require_auth($c, audience => 'access', allow_refresh => 1);
80
+
my (undef, $account) = require_auth($c, audience => 'access');
81
81
xrpc_error(500, 'SigningKeyUnavailable', 'Account signing key is unavailable')
82
82
unless defined($account->{private_key}) && length($account->{private_key});
83
83
$headers{Authorization} = 'Bearer ' . encode_service_jwt(
···
215
215
xrpc_error(405, 'MethodNotAllowed', 'app.bsky.actor.getPreferences expects GET')
216
216
unless $c->req->method eq 'GET';
217
217
218
-
my (undef, $account) = require_auth($c, audience => 'access', allow_refresh => 1);
218
+
my (undef, $account) = require_auth($c, audience => 'access');
219
219
my $preferences = $c->store->list_preferences($account->{did}, 'app.bsky');
220
220
$c->render(json => { preferences => $preferences });
221
221
return 200;
···
225
225
xrpc_error(405, 'MethodNotAllowed', 'app.bsky.actor.putPreferences expects POST')
226
226
unless $c->req->method eq 'POST';
227
227
228
-
my (undef, $account) = require_auth($c, audience => 'access', allow_refresh => 1);
228
+
my (undef, $account) = require_auth($c, audience => 'access');
229
229
my $body = $c->req->json || {};
230
230
my $preferences = $body->{preferences};
231
231
xrpc_error(400, 'InvalidRequest', 'preferences must be an array')
···
349
349
sub _optional_auth_account ($self, $c) {
350
350
my $auth = $c->req->headers->authorization;
351
351
return undef unless defined $auth && length $auth;
352
-
my (undef, $account) = require_auth($c, audience => 'access', allow_refresh => 1);
352
+
my (undef, $account) = require_auth($c, audience => 'access');
353
353
return $account;
354
354
}
355
355
···
425
425
sub _resolve_local_post_uri ($self, $c, $uri) {
426
426
my ($repo, $collection, $rkey) = parse_at_uri($uri);
427
427
return undef unless defined $repo && defined $collection && defined $rkey;
428
-
return undef unless $collection eq 'app.bsky.feed.post';
429
428
my $account = resolve_repo($c, $repo) or return undef;
430
-
my $row = $c->store->get_record($account->{did}, $collection, $rkey) or return undef;
429
+
xrpc_error(404, 'RecordNotFound', 'Record was not found')
430
+
unless $collection eq 'app.bsky.feed.post';
431
+
my $row = $c->store->get_record($account->{did}, $collection, $rkey);
432
+
xrpc_error(404, 'RecordNotFound', 'Record was not found') unless $row;
431
433
return [ $account, $row ];
432
434
}
433
435
+84
t/api-util.t
+84
t/api-util.t
···
1
+
use v5.34;
2
+
use warnings;
3
+
4
+
use Config ();
5
+
use File::Spec;
6
+
use FindBin qw($Bin);
7
+
use Test::More;
8
+
9
+
BEGIN {
10
+
require lib;
11
+
my $root = File::Spec->rel2abs(File::Spec->catdir($Bin, '..'));
12
+
lib->import(
13
+
File::Spec->catdir($root, 'lib'),
14
+
File::Spec->catdir($root, 'local', 'lib', 'perl5'),
15
+
File::Spec->catdir($root, 'local', 'lib', 'perl5', $Config::Config{archname}),
16
+
);
17
+
}
18
+
19
+
use ATProto::PDS::API::Util qw(flatten_params resolve_did_account resolve_repo);
20
+
21
+
{
22
+
package ApiUtilTestStore;
23
+
24
+
sub new {
25
+
my ($class, %args) = @_;
26
+
return bless \%args, $class;
27
+
}
28
+
29
+
sub get_account_by_handle {
30
+
my ($self, $handle) = @_;
31
+
return $self->{accounts_by_handle}{$handle};
32
+
}
33
+
34
+
sub get_account_by_did {
35
+
my ($self, $did) = @_;
36
+
return $self->{accounts_by_did}{$did};
37
+
}
38
+
39
+
sub list_accounts {
40
+
my ($self) = @_;
41
+
return $self->{list_accounts} // [];
42
+
}
43
+
}
44
+
45
+
{
46
+
package ApiUtilTestContext;
47
+
48
+
sub new {
49
+
my ($class, $store) = @_;
50
+
return bless { store => $store }, $class;
51
+
}
52
+
53
+
sub store {
54
+
my ($self) = @_;
55
+
return $self->{store};
56
+
}
57
+
}
58
+
59
+
is_deeply(
60
+
[ flatten_params('a', ['b', 'c'], 'd') ],
61
+
['a', 'b', 'c', 'd'],
62
+
'flatten_params flattens repeated query-style values',
63
+
);
64
+
65
+
my $store = ApiUtilTestStore->new(
66
+
accounts_by_handle => {
67
+
'alice.test' => { did => 'did:plc:alice', handle => 'alice.test' },
68
+
},
69
+
accounts_by_did => {
70
+
'did:plc:alice' => { did => 'did:plc:alice', handle => 'alice.test' },
71
+
},
72
+
list_accounts => [
73
+
{ did => 'did:plc:alice', handle => 'alice.test' },
74
+
],
75
+
);
76
+
77
+
my $c = ApiUtilTestContext->new($store);
78
+
79
+
is(resolve_repo($c, 'alice.test')->{did}, 'did:plc:alice', 'resolve_repo finds handles directly');
80
+
is(resolve_repo($c, 'did:plc:alice')->{handle}, 'alice.test', 'resolve_repo finds plain DIDs directly');
81
+
is(resolve_did_account($c, 'did%3Aplc%3Aalice')->{handle}, 'alice.test', 'resolve_did_account accepts percent-encoded DIDs');
82
+
is(resolve_repo($c, undef), undef, 'resolve_repo returns undef for empty input');
83
+
84
+
done_testing;
+114
t/service-proxy-local.t
+114
t/service-proxy-local.t
···
1
+
use v5.34;
2
+
use warnings;
3
+
4
+
use Config ();
5
+
use File::Spec;
6
+
use FindBin qw($Bin);
7
+
use Test::More;
8
+
9
+
BEGIN {
10
+
require lib;
11
+
my $root = File::Spec->rel2abs(File::Spec->catdir($Bin, '..'));
12
+
lib->import(
13
+
File::Spec->catdir($root, 'lib'),
14
+
File::Spec->catdir($root, 'local', 'lib', 'perl5'),
15
+
File::Spec->catdir($root, 'local', 'lib', 'perl5', $Config::Config{archname}),
16
+
);
17
+
}
18
+
19
+
use ATProto::PDS::ServiceProxy;
20
+
21
+
{
22
+
package LocalTestStore;
23
+
24
+
sub new {
25
+
my ($class, %args) = @_;
26
+
return bless \%args, $class;
27
+
}
28
+
29
+
sub get_account_by_handle {
30
+
my ($self, $handle) = @_;
31
+
return $self->{accounts_by_handle}{$handle};
32
+
}
33
+
34
+
sub get_account_by_did {
35
+
my ($self, $did) = @_;
36
+
return $self->{accounts_by_did}{$did};
37
+
}
38
+
39
+
sub list_accounts {
40
+
my ($self) = @_;
41
+
return $self->{list_accounts} // [];
42
+
}
43
+
44
+
sub get_record {
45
+
my ($self, $did, $collection, $rkey) = @_;
46
+
return $self->{records}{"$did|$collection|$rkey"};
47
+
}
48
+
}
49
+
50
+
{
51
+
package LocalTestContext;
52
+
53
+
sub new {
54
+
my ($class, $store) = @_;
55
+
return bless { store => $store }, $class;
56
+
}
57
+
58
+
sub store {
59
+
my ($self) = @_;
60
+
return $self->{store};
61
+
}
62
+
}
63
+
64
+
my $proxy = ATProto::PDS::ServiceProxy->new;
65
+
my $did = 'did:plc:alice';
66
+
67
+
my $store = LocalTestStore->new(
68
+
accounts_by_did => {
69
+
$did => {
70
+
did => $did,
71
+
handle => 'alice.test',
72
+
},
73
+
},
74
+
accounts_by_handle => {
75
+
'alice.test' => {
76
+
did => $did,
77
+
handle => 'alice.test',
78
+
},
79
+
},
80
+
records => {
81
+
"$did|app.bsky.feed.post|present-post" => {
82
+
collection => 'app.bsky.feed.post',
83
+
rkey => 'present-post',
84
+
cid => 'bafyreitest',
85
+
value => { text => 'hello' },
86
+
},
87
+
},
88
+
);
89
+
90
+
my $c = LocalTestContext->new($store);
91
+
92
+
my $resolved = $proxy->_resolve_local_post_uri($c, "at://$did/app.bsky.feed.post/present-post");
93
+
is($resolved->[0]{did}, $did, 'local post lookup returns the local account');
94
+
is($resolved->[1]{rkey}, 'present-post', 'local post lookup returns the local record');
95
+
96
+
eval { $proxy->_resolve_local_post_uri($c, "at://$did/app.bsky.feed.post/missing-post") };
97
+
my $missing = $@;
98
+
is(ref($missing), 'HASH', 'missing local post throws an xrpc error');
99
+
is($missing->{status}, 404, 'missing local post returns 404');
100
+
is($missing->{error}, 'RecordNotFound', 'missing local post returns RecordNotFound');
101
+
102
+
eval { $proxy->_resolve_local_post_uri($c, "at://$did/app.bsky.feed.repost/not-a-post") };
103
+
my $wrong_collection = $@;
104
+
is(ref($wrong_collection), 'HASH', 'non-post local URI throws an xrpc error');
105
+
is($wrong_collection->{status}, 404, 'non-post local URI returns 404');
106
+
is($wrong_collection->{error}, 'RecordNotFound', 'non-post local URI returns RecordNotFound');
107
+
108
+
is(
109
+
$proxy->_resolve_local_post_uri($c, 'at://did:plc:bob/app.bsky.feed.post/remote-post'),
110
+
undef,
111
+
'remote posts still fall back to upstream handling',
112
+
);
113
+
114
+
done_testing;