perlsky is a Perl 5 implementation of an AT Protocol Personal Data Server.
Expand external XRPC endpoint coverage
+409
-42
+9
-1
lib/ATProto/PDS/API/Admin.pm
+9
-1
lib/ATProto/PDS/API/Admin.pm
···
25
25
26
26
$registry->register('com.atproto.admin.getAccountInfos', sub ($c, $endpoint) {
27
27
require_admin($c);
28
-
my @dids = $c->every_param('dids');
28
+
my @dids = _flatten_params($c->every_param('dids'));
29
29
return {
30
30
infos => [
31
31
map { account_view($_) }
···
229
229
);
230
230
return {};
231
231
});
232
+
}
233
+
234
+
sub _flatten_params (@values) {
235
+
my @flat;
236
+
for my $value (@values) {
237
+
push @flat, ref($value) eq 'ARRAY' ? @$value : $value;
238
+
}
239
+
return @flat;
232
240
}
233
241
234
242
sub _subject_from_params ($c) {
+8
-4
lib/ATProto/PDS/API/Builtins.pm
+8
-4
lib/ATProto/PDS/API/Builtins.pm
···
87
87
});
88
88
89
89
$registry->register('com.atproto.temp.checkHandleAvailability', sub ($c, $endpoint) {
90
-
my $payload = $c->req->json || {};
91
-
my $handle = normalize_handle($payload->{handle} // '', $c->config_value('service_handle_domain', 'localhost'));
90
+
my $handle = normalize_handle($c->param('handle') // '', $c->config_value('service_handle_domain', 'localhost'));
92
91
my $service_handle = lc($c->config_value('service_handle_domain', 'localhost'));
92
+
my $available = defined $handle
93
+
&& $handle ne ''
94
+
&& $handle ne $service_handle
95
+
&& !$c->store->get_account_by_handle($handle)
96
+
&& !$c->store->get_reserved_handle($handle);
93
97
return {
94
-
handle => $handle // ($payload->{handle} // ''),
95
-
available => (defined $handle && $handle ne '' && $handle ne $service_handle && !$c->store->get_account_by_handle($handle) ? true : false),
98
+
handle => $handle // ($c->param('handle') // ''),
99
+
available => $available ? true : false,
96
100
};
97
101
});
98
102
}
+12
-3
lib/ATProto/PDS/API/Misc.pm
+12
-3
lib/ATProto/PDS/API/Misc.pm
···
8
8
use Exporter 'import';
9
9
use JSON::PP ();
10
10
11
-
use ATProto::PDS::API::Helpers qw(find_account subject_key);
11
+
use ATProto::PDS::API::Helpers qw(find_account require_admin subject_key);
12
12
use ATProto::PDS::API::Server qw(require_auth);
13
13
use ATProto::PDS::API::Util qw(iso8601 xrpc_error);
14
14
use ATProto::PDS::Auth::Password qw(hash_password random_hex);
···
148
148
});
149
149
150
150
$registry->register('com.atproto.lexicon.resolveLexicon', sub ($c, $endpoint) {
151
-
my $nsid = $c->param('nsid') // q();
151
+
my $nsid = $c->req->url->query->param('nsid') // q();
152
152
my $schema = $c->lexicons->get($nsid);
153
153
xrpc_error(404, 'LexiconNotFound', "No lexicon found for $nsid") unless $schema;
154
154
my $bytes = encode_dag_cbor($schema);
···
181
181
});
182
182
183
183
$registry->register('com.atproto.label.queryLabels', sub ($c, $endpoint) {
184
-
my $patterns = [ $c->every_param('uriPatterns') ];
184
+
my $patterns = [ _flatten_params($c->every_param('uriPatterns')) ];
185
185
xrpc_error(400, 'InvalidRequest', 'uriPatterns is required') unless @$patterns;
186
186
my @labels = grep { _matches_patterns($_->{uri}, $patterns) } @{ _current_labels($c) };
187
187
my $limit = $c->param('limit') // 50;
···
217
217
});
218
218
219
219
$registry->register('com.atproto.temp.addReservedHandle', sub ($c, $endpoint) {
220
+
require_admin($c);
220
221
my $body = $c->req->json || {};
221
222
my $domain = $c->config_value('service_handle_domain', 'localhost');
222
223
my $handle = normalize_handle($body->{handle}, $domain);
···
261
262
});
262
263
return {};
263
264
});
265
+
}
266
+
267
+
sub _flatten_params (@values) {
268
+
my @flat;
269
+
for my $value (@values) {
270
+
push @flat, ref($value) eq 'ARRAY' ? @$value : $value;
271
+
}
272
+
return @flat;
264
273
}
265
274
266
275
sub _current_labels ($c) {
+47
lib/ATProto/PDS/API/Repo.pm
+47
lib/ATProto/PDS/API/Repo.pm
···
6
6
no warnings 'experimental::signatures';
7
7
8
8
use Exporter 'import';
9
+
use File::Path qw(make_path);
10
+
use File::Spec;
9
11
use JSON::PP ();
10
12
11
13
use ATProto::PDS::API::Server qw(require_auth);
14
+
use ATProto::PDS::API::Util qw(blob_ref);
15
+
use ATProto::PDS::Repo::CID;
12
16
13
17
our @EXPORT_OK = qw(register_repo_handlers);
14
18
···
131
135
} @{ $page->{items} }
132
136
],
133
137
};
138
+
});
139
+
140
+
$registry->register('com.atproto.repo.uploadBlob', sub ($c, $endpoint) {
141
+
my (undef, $account) = require_auth($c, audience => 'access', allow_refresh => 1);
142
+
my $bytes = $c->req->body // q();
143
+
my $cid = ATProto::PDS::Repo::CID->for_raw($bytes)->to_string;
144
+
my $data_dir = $c->config_value('data_dir', File::Spec->catdir($c->app->project_root, 'data', 'runtime'));
145
+
my $blob_dir = File::Spec->catdir($data_dir, 'blobs');
146
+
make_path($blob_dir);
147
+
my $path = File::Spec->catfile($blob_dir, $cid);
148
+
open(my $fh, '>:raw', $path) or _xrpc_error(500, 'StorageFailure', "Unable to write blob $cid");
149
+
print {$fh} $bytes;
150
+
close($fh);
151
+
152
+
my $mime_type = $c->req->headers->content_type || 'application/octet-stream';
153
+
$c->store->put_blob(
154
+
cid => $cid,
155
+
did => $account->{did},
156
+
mime_type => $mime_type,
157
+
byte_size => length($bytes),
158
+
storage_path => $path,
159
+
temporary => 1,
160
+
);
161
+
162
+
return {
163
+
blob => blob_ref($cid, $mime_type, length($bytes)),
164
+
};
165
+
});
166
+
167
+
$registry->register('com.atproto.repo.listMissingBlobs', sub ($c, $endpoint) {
168
+
my (undef, $account) = require_auth($c, audience => 'access', allow_refresh => 1);
169
+
my $page = {
170
+
items => [],
171
+
cursor => undef,
172
+
};
173
+
return {
174
+
blobs => $page->{items},
175
+
};
176
+
});
177
+
178
+
$registry->register('com.atproto.repo.importRepo', sub ($c, $endpoint) {
179
+
my (undef, $account) = require_auth($c, audience => 'access', allow_refresh => 1);
180
+
_xrpc_error(400, 'UnsupportedRepoImport', "Repo import is not yet supported for $account->{did}");
134
181
});
135
182
}
136
183
+47
-3
lib/ATProto/PDS/API/Server.pm
+47
-3
lib/ATProto/PDS/API/Server.pm
···
13
13
use ATProto::PDS::Auth::JWT qw(decode_jwt encode_jwt);
14
14
use ATProto::PDS::Auth::Password qw(hash_password random_hex);
15
15
use ATProto::PDS::Identity qw(account_did account_did_doc normalize_handle service_did);
16
+
use ATProto::PDS::Repo::CAR qw(read_car);
16
17
17
18
our @EXPORT_OK = qw(register_server_handlers require_auth session_view);
18
19
···
85
86
used_by => $account->{did},
86
87
) if $invite;
87
88
$c->store->claim_reserved_signing_key($did) if $reserved && !defined $reserved->{claimed_at};
89
+
$c->store->append_event(
90
+
did => $account->{did},
91
+
type => 'account',
92
+
rev => $account->{repo_rev},
93
+
payload => {
94
+
active => JSON::PP::true,
95
+
},
96
+
);
88
97
89
98
return _issue_session($c, $account);
90
99
});
···
122
131
123
132
$registry->register('com.atproto.server.checkAccountStatus', sub ($c, $endpoint) {
124
133
my (undef, $account) = require_auth($c, audience => 'access', allow_refresh => 1);
134
+
my $car = $c->store->repo_car($account->{did});
135
+
my $block_count = 0;
136
+
$block_count = scalar @{ read_car($car)->{blocks} } if defined $car && length $car;
125
137
return {
126
-
active => (!defined($account->{deactivated_at}) && !defined($account->{deleted_at}))
138
+
activated => (!defined($account->{deactivated_at}) && !defined($account->{deleted_at}))
127
139
? JSON::PP::true
128
140
: JSON::PP::false,
129
-
(defined($account->{deleted_at}) ? (status => 'deleted') : ()),
130
-
(defined($account->{deactivated_at}) && !defined($account->{deleted_at}) ? (status => 'deactivated') : ()),
141
+
validDid => ($account->{did} // q()) =~ /^did:/ ? JSON::PP::true : JSON::PP::false,
142
+
repoCommit => $account->{repo_commit_cid} // q(),
143
+
repoRev => $account->{repo_rev} // q(),
144
+
repoBlocks => 0 + $block_count,
145
+
indexedRecords => 0 + $c->store->count_records_by_did($account->{did}),
146
+
privateStateValues => 0,
147
+
expectedBlobs => 0 + $c->store->count_blobs_by_did($account->{did}),
148
+
importedBlobs => 0 + $c->store->count_blobs_by_did($account->{did}),
131
149
};
132
150
});
133
151
···
183
201
$registry->register('com.atproto.server.deactivateAccount', sub ($c, $endpoint) {
184
202
my (undef, $account) = require_auth($c, audience => 'access', allow_refresh => 1);
185
203
$c->store->update_account($account->{did}, deactivated_at => time);
204
+
$c->store->append_event(
205
+
did => $account->{did},
206
+
type => 'account',
207
+
rev => $account->{repo_rev},
208
+
payload => {
209
+
active => JSON::PP::false,
210
+
status => 'deactivated',
211
+
},
212
+
);
186
213
return {};
187
214
});
188
215
189
216
$registry->register('com.atproto.server.activateAccount', sub ($c, $endpoint) {
190
217
my (undef, $account) = require_auth($c, audience => 'access', allow_refresh => 1);
191
218
$c->store->update_account($account->{did}, deactivated_at => undef);
219
+
$c->store->append_event(
220
+
did => $account->{did},
221
+
type => 'account',
222
+
rev => $account->{repo_rev},
223
+
payload => {
224
+
active => JSON::PP::true,
225
+
},
226
+
);
192
227
return {};
193
228
});
194
229
···
352
387
$c->store->revoke_sessions_by_did($account->{did});
353
388
$c->store->revoke_app_passwords_by_did($account->{did});
354
389
$c->store->consume_action_token($token->{token});
390
+
$c->store->append_event(
391
+
did => $account->{did},
392
+
type => 'account',
393
+
rev => $account->{repo_rev},
394
+
payload => {
395
+
active => JSON::PP::false,
396
+
status => 'deleted',
397
+
},
398
+
);
355
399
});
356
400
return {};
357
401
});
+231
-29
lib/ATProto/PDS/API/Sync.pm
+231
-29
lib/ATProto/PDS/API/Sync.pm
···
8
8
use Exporter 'import';
9
9
use JSON::PP ();
10
10
11
+
use ATProto::PDS::API::Util qw(iso8601 resolve_did_account xrpc_error);
12
+
use ATProto::PDS::Identity qw(service_host);
13
+
use ATProto::PDS::Repo::CAR qw(write_car);
14
+
use ATProto::PDS::Repo::CID;
15
+
11
16
our @EXPORT_OK = qw(register_sync_handlers);
12
17
13
18
sub register_sync_handlers ($registry, $app) {
14
19
$registry->register('com.atproto.sync.getLatestCommit', sub ($c, $endpoint) {
15
-
my $account = _account_for_did($c, $c->param('did') // q());
16
-
_xrpc_error(404, 'RepoNotFound', 'Repository was not found') unless $account;
20
+
my $account = resolve_did_account($c, $c->param('did') // q());
21
+
xrpc_error(404, 'RepoNotFound', 'Repository was not found') unless $account;
17
22
my $head = $c->store->get_repo_head($account->{did});
18
-
_xrpc_error(404, 'RepoNotFound', 'Repository was not found') unless $head;
23
+
xrpc_error(404, 'RepoNotFound', 'Repository was not found') unless $head;
19
24
return {
20
25
cid => $head->{commit_cid},
21
26
rev => $head->{rev},
22
27
};
23
28
});
24
29
30
+
$registry->register('com.atproto.sync.getHead', sub ($c, $endpoint) {
31
+
my $account = resolve_did_account($c, $c->param('did') // q());
32
+
xrpc_error(404, 'HeadNotFound', 'Repository head was not found') unless $account;
33
+
my $head = $c->store->get_repo_head($account->{did});
34
+
xrpc_error(404, 'HeadNotFound', 'Repository head was not found') unless $head;
35
+
return {
36
+
root => $head->{commit_cid},
37
+
};
38
+
});
39
+
25
40
$registry->register('com.atproto.sync.getRepoStatus', sub ($c, $endpoint) {
26
-
my $account = _account_for_did($c, $c->param('did') // q());
27
-
_xrpc_error(404, 'RepoNotFound', 'Repository was not found') unless $account;
41
+
my $account = resolve_did_account($c, $c->param('did') // q());
42
+
xrpc_error(404, 'RepoNotFound', 'Repository was not found') unless $account;
28
43
return {
29
44
did => $account->{did},
30
45
active => defined($account->{deactivated_at}) ? JSON::PP::false : JSON::PP::true,
31
46
(defined($account->{repo_rev}) ? (rev => $account->{repo_rev}) : ()),
32
47
(defined($account->{deactivated_at}) ? (status => 'deactivated') : ()),
48
+
(defined($account->{deleted_at}) ? (status => 'deleted') : ()),
33
49
};
34
50
});
35
51
36
52
$registry->register('com.atproto.sync.getRepo', sub ($c, $endpoint) {
37
-
my $account = _account_for_did($c, $c->param('did') // q());
38
-
_xrpc_error(404, 'RepoNotFound', 'Repository was not found') unless $account;
53
+
my $account = resolve_did_account($c, $c->param('did') // q());
54
+
xrpc_error(404, 'RepoNotFound', 'Repository was not found') unless $account;
55
+
my $car = $c->store->repo_car($account->{did});
56
+
xrpc_error(404, 'RepoNotFound', 'Repository was not found') unless defined $car;
57
+
$c->res->headers->content_type('application/vnd.ipld.car');
58
+
$c->render(data => $car);
59
+
return;
60
+
});
61
+
62
+
$registry->register('com.atproto.sync.getCheckout', sub ($c, $endpoint) {
63
+
my $account = resolve_did_account($c, $c->param('did') // q());
64
+
xrpc_error(404, 'RepoNotFound', 'Repository was not found') unless $account;
39
65
my $car = $c->store->repo_car($account->{did});
40
-
_xrpc_error(404, 'RepoNotFound', 'Repository was not found') unless defined $car;
66
+
xrpc_error(404, 'RepoNotFound', 'Repository was not found') unless defined $car;
41
67
$c->res->headers->content_type('application/vnd.ipld.car');
42
68
$c->render(data => $car);
43
69
return;
44
70
});
45
71
46
72
$registry->register('com.atproto.sync.getRecord', sub ($c, $endpoint) {
47
-
my $account = _account_for_did($c, $c->param('did') // q());
48
-
_xrpc_error(404, 'RepoNotFound', 'Repository was not found') unless $account;
73
+
my $account = resolve_did_account($c, $c->param('did') // q());
74
+
xrpc_error(404, 'RepoNotFound', 'Repository was not found') unless $account;
49
75
my $record = $c->store->get_record($account->{did}, $c->param('collection'), $c->param('rkey'));
50
-
_xrpc_error(404, 'RecordNotFound', 'Record was not found') unless $record;
76
+
xrpc_error(404, 'RecordNotFound', 'Record was not found') unless $record;
51
77
my $car = $c->store->repo_car($account->{did});
52
-
_xrpc_error(404, 'RepoNotFound', 'Repository was not found') unless defined $car;
78
+
xrpc_error(404, 'RepoNotFound', 'Repository was not found') unless defined $car;
53
79
$c->res->headers->content_type('application/vnd.ipld.car');
54
80
$c->render(data => $car);
55
81
return;
56
82
});
57
83
84
+
$registry->register('com.atproto.sync.getBlocks', sub ($c, $endpoint) {
85
+
my $account = resolve_did_account($c, $c->param('did') // q());
86
+
xrpc_error(404, 'RepoNotFound', 'Repository was not found') unless $account;
87
+
my @cids = _flatten_params($c->every_param('cids'));
88
+
xrpc_error(400, 'InvalidRequest', 'At least one CID is required') unless @cids;
89
+
my $rows = $c->store->get_blocks(\@cids);
90
+
my %found = map { $_->{cid} => $_ } @$rows;
91
+
for my $cid (@cids) {
92
+
xrpc_error(404, 'BlockNotFound', "Block $cid was not found") unless $found{$cid};
93
+
}
94
+
my @blocks = map {
95
+
+{
96
+
cid => ATProto::PDS::Repo::CID->from_string($_),
97
+
bytes => $found{$_}{bytes},
98
+
}
99
+
} @cids;
100
+
my $car = write_car($blocks[0]{cid}, \@blocks);
101
+
$c->res->headers->content_type('application/vnd.ipld.car');
102
+
$c->render(data => $car);
103
+
return;
104
+
});
105
+
106
+
$registry->register('com.atproto.sync.getBlob', sub ($c, $endpoint) {
107
+
my $account = resolve_did_account($c, $c->param('did') // q());
108
+
xrpc_error(404, 'RepoNotFound', 'Repository was not found') unless $account;
109
+
my $blob = $c->store->get_blob($c->param('cid') // q());
110
+
xrpc_error(404, 'BlobNotFound', 'Blob was not found')
111
+
unless $blob && ($blob->{did} // q()) eq $account->{did};
112
+
xrpc_error(404, 'BlobNotFound', 'Blob content is not available')
113
+
unless $blob->{storage_path} && -f $blob->{storage_path};
114
+
open(my $fh, '<:raw', $blob->{storage_path}) or xrpc_error(500, 'StorageFailure', 'Unable to read blob');
115
+
local $/ = undef;
116
+
my $bytes = <$fh>;
117
+
close($fh);
118
+
$c->res->headers->content_type($blob->{mime_type} || 'application/octet-stream');
119
+
$c->render(data => $bytes);
120
+
return;
121
+
});
122
+
58
123
$registry->register('com.atproto.sync.listRepos', sub ($c, $endpoint) {
59
124
my $page = $c->store->list_repos(
60
125
limit => $c->param('limit') // 500,
···
66
131
};
67
132
});
68
133
134
+
$registry->register('com.atproto.sync.listReposByCollection', sub ($c, $endpoint) {
135
+
my $page = $c->store->list_repos_by_collection(
136
+
$c->param('collection'),
137
+
limit => $c->param('limit') // 500,
138
+
cursor => $c->param('cursor'),
139
+
);
140
+
return {
141
+
(defined $page->{cursor} ? (cursor => $page->{cursor}) : ()),
142
+
repos => [ map { +{ did => $_->{did} } } @{ $page->{items} } ],
143
+
};
144
+
});
145
+
69
146
$registry->register('com.atproto.sync.listBlobs', sub ($c, $endpoint) {
70
-
my $account = _account_for_did($c, $c->param('did') // q());
71
-
_xrpc_error(404, 'RepoNotFound', 'Repository was not found') unless $account;
147
+
my $account = resolve_did_account($c, $c->param('did') // q());
148
+
xrpc_error(404, 'RepoNotFound', 'Repository was not found') unless $account;
72
149
my $page = $c->store->list_blobs_by_did(
73
150
$account->{did},
74
151
limit => $c->param('limit') // 500,
···
79
156
cids => [ map { $_->{cid} } @{ $page->{items} } ],
80
157
};
81
158
});
159
+
160
+
$registry->register('com.atproto.sync.requestCrawl', sub ($c, $endpoint) {
161
+
my $body = $c->req->json || {};
162
+
my $host = $c->store->touch_host_notice(
163
+
hostname => $body->{hostname},
164
+
requested_at => time,
165
+
last_seq => $c->store->latest_event_seq,
166
+
status => { status => 'active' },
167
+
);
168
+
return {};
169
+
});
170
+
171
+
$registry->register('com.atproto.sync.notifyOfUpdate', sub ($c, $endpoint) {
172
+
my $body = $c->req->json || {};
173
+
$c->store->touch_host_notice(
174
+
hostname => $body->{hostname},
175
+
notified_at => time,
176
+
last_seq => $c->store->latest_event_seq,
177
+
status => { status => 'active' },
178
+
);
179
+
return {};
180
+
});
181
+
182
+
$registry->register('com.atproto.sync.listHosts', sub ($c, $endpoint) {
183
+
my $page = $c->store->list_host_notices(
184
+
limit => $c->param('limit') // 200,
185
+
cursor => $c->param('cursor'),
186
+
);
187
+
my @hosts = map { _host_view($c, $_) } @{ $page->{items} };
188
+
if (!@hosts) {
189
+
push @hosts, _host_view($c, {
190
+
hostname => service_host($c->app->settings),
191
+
last_seq => $c->store->latest_event_seq,
192
+
status => { status => 'active' },
193
+
});
194
+
}
195
+
return {
196
+
(defined $page->{cursor} ? (cursor => $page->{cursor}) : ()),
197
+
hosts => \@hosts,
198
+
};
199
+
});
200
+
201
+
$registry->register('com.atproto.sync.getHostStatus', sub ($c, $endpoint) {
202
+
my $hostname = $c->param('hostname') // q();
203
+
my $host = $c->store->get_host_notice($hostname);
204
+
if (!$host && $hostname eq service_host($c->app->settings)) {
205
+
$host = {
206
+
hostname => $hostname,
207
+
last_seq => $c->store->latest_event_seq,
208
+
status => { status => 'active' },
209
+
};
210
+
}
211
+
xrpc_error(404, 'HostNotFound', 'Host was not found') unless $host;
212
+
return _host_view($c, $host);
213
+
});
214
+
215
+
$registry->register('com.atproto.sync.subscribeRepos', sub ($c, $endpoint) {
216
+
my $cursor = int($c->param('cursor') // 0);
217
+
my $latest = $c->store->latest_event_seq;
218
+
if ($cursor > $latest) {
219
+
$c->send({ json => {
220
+
name => 'OutdatedCursor',
221
+
message => 'Cursor is ahead of the local event stream',
222
+
}});
223
+
$c->finish(1000);
224
+
return;
225
+
}
226
+
227
+
my $events = $c->store->list_events_after($cursor, limit => 100);
228
+
for my $event (@$events) {
229
+
my $message = _event_message($event);
230
+
next unless $message;
231
+
$c->send({ json => $message });
232
+
}
233
+
234
+
$c->finish(1000);
235
+
return;
236
+
});
82
237
}
83
238
84
-
sub _account_for_did ($c, $did) {
85
-
my $account = $c->store->get_account_by_did($did);
86
-
return $account if $account;
87
-
my $target = lc($did // q());
88
-
$target =~ s/%3a/:/ig;
89
-
for my $row (@{ $c->store->list_accounts }) {
90
-
my $candidate = lc($row->{did} // q());
91
-
$candidate =~ s/%3a/:/ig;
92
-
return $row if $candidate eq $target;
239
+
sub _flatten_params (@values) {
240
+
my @flat;
241
+
for my $value (@values) {
242
+
push @flat, ref($value) eq 'ARRAY' ? @$value : $value;
93
243
}
94
-
return undef;
244
+
return @flat;
95
245
}
96
246
97
-
sub _xrpc_error ($status, $error, $message) {
98
-
die {
99
-
status => $status,
100
-
error => $error,
101
-
message => $message,
247
+
sub _host_view ($c, $row) {
248
+
return {
249
+
hostname => $row->{hostname},
250
+
seq => 0 + ($row->{last_seq} // 0),
251
+
accountCount => 0 + scalar(@{ $c->store->list_accounts }),
252
+
status => $row->{status}{status} || 'active',
102
253
};
254
+
}
255
+
256
+
sub _event_message ($event) {
257
+
if (($event->{type} // q()) eq 'commit') {
258
+
my @ops;
259
+
my $writes = $event->{payload}{writes} || [];
260
+
my $results = $event->{payload}{results} || [];
261
+
for my $idx (0 .. $#$writes) {
262
+
my $write = $writes->[$idx];
263
+
my $result = $results->[$idx] || {};
264
+
push @ops, {
265
+
action => $write->{action},
266
+
path => join('/', grep { defined && length } $write->{collection}, $write->{rkey}),
267
+
cid => ($write->{action} eq 'delete' ? undef : $result->{cid}),
268
+
};
269
+
}
270
+
return {
271
+
seq => 0 + $event->{seq},
272
+
rebase => JSON::PP::false,
273
+
tooBig => JSON::PP::false,
274
+
repo => $event->{did},
275
+
commit => { '$link' => $event->{commit_cid} },
276
+
rev => $event->{rev},
277
+
since => undef,
278
+
blocks => unpack('H*', $event->{car_bytes} // q()),
279
+
ops => \@ops,
280
+
blobs => [],
281
+
time => iso8601($event->{created_at}),
282
+
};
283
+
}
284
+
285
+
if (($event->{type} // q()) eq 'identity') {
286
+
return {
287
+
seq => 0 + $event->{seq},
288
+
did => $event->{did},
289
+
handle => $event->{payload}{handle},
290
+
time => iso8601($event->{created_at}),
291
+
};
292
+
}
293
+
294
+
if (($event->{type} // q()) eq 'account') {
295
+
return {
296
+
seq => 0 + $event->{seq},
297
+
did => $event->{did},
298
+
active => $event->{payload}{active} ? JSON::PP::true : JSON::PP::false,
299
+
($event->{payload}{status} ? (status => $event->{payload}{status}) : ()),
300
+
time => iso8601($event->{created_at}),
301
+
};
302
+
}
303
+
304
+
return undef;
103
305
}
104
306
105
307
1;
+47
-1
lib/ATProto/PDS/API/Util.pm
+47
-1
lib/ATProto/PDS/API/Util.pm
···
6
6
no warnings 'experimental::signatures';
7
7
8
8
use Exporter 'import';
9
+
use JSON::PP ();
9
10
10
-
our @EXPORT_OK = qw(xrpc_error iso8601);
11
+
our @EXPORT_OK = qw(
12
+
blob_ref
13
+
iso8601
14
+
resolve_did_account
15
+
resolve_repo
16
+
subject_key
17
+
xrpc_error
18
+
);
11
19
12
20
sub xrpc_error ($status, $error, $message) {
13
21
die {
···
28
36
$gmt[1],
29
37
$gmt[0],
30
38
);
39
+
}
40
+
41
+
sub resolve_did_account ($c, $did) {
42
+
my $account = $c->store->get_account_by_did($did);
43
+
return $account if $account;
44
+
my $target = lc($did // q());
45
+
$target =~ s/%3a/:/ig;
46
+
for my $row (@{ $c->store->list_accounts }) {
47
+
my $candidate = lc($row->{did} // q());
48
+
$candidate =~ s/%3a/:/ig;
49
+
return $row if $candidate eq $target;
50
+
}
51
+
return undef;
52
+
}
53
+
54
+
sub resolve_repo ($c, $repo) {
55
+
return undef unless defined $repo && length $repo;
56
+
return $c->store->get_account_by_handle($repo) unless $repo =~ /\Adid:/;
57
+
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
+
}
69
+
70
+
sub blob_ref ($cid, $mime_type, $size) {
71
+
return {
72
+
'$type' => 'blob',
73
+
ref => { '$link' => $cid },
74
+
mimeType => $mime_type,
75
+
size => $size + 0,
76
+
};
31
77
}
32
78
33
79
1;
+8
-1
lib/ATProto/PDS/Store/SQLite.pm
+8
-1
lib/ATProto/PDS/Store/SQLite.pm
···
726
726
sub list_events_after ($self, $cursor, %args) {
727
727
my $limit = $args{limit} // 100;
728
728
my $sql = q{SELECT * FROM events WHERE seq > ? ORDER BY seq LIMIT ?};
729
-
return $self->dbh->selectall_arrayref($sql, { Slice => {} }, $cursor // 0, $limit);
729
+
my $rows = $self->dbh->selectall_arrayref($sql, { Slice => {} }, $cursor // 0, $limit);
730
+
return [ map { _row_from_json_columns($_, qw(payload_json)) } @$rows ];
731
+
}
732
+
733
+
sub latest_event_seq ($self) {
734
+
return $self->dbh->selectrow_array(
735
+
q{SELECT COALESCE(MAX(seq), 0) FROM events},
736
+
) // 0;
730
737
}
731
738
732
739
sub create_action_token ($self, %args) {