perlsky is a Perl 5 implementation of an AT Protocol Personal Data Server.
Simplify repo write handlers
+75
-62
+60
-60
lib/ATProto/PDS/API/Repo.pm
+60
-60
lib/ATProto/PDS/API/Repo.pm
···
19
19
20
20
sub register_repo_handlers ($registry, $app) {
21
21
$registry->register('com.atproto.repo.describeRepo', sub ($c, $endpoint) {
22
-
my $account = resolve_repo($c, $c->param('repo'));
23
-
xrpc_error(404, 'RepoNotFound', 'Repository was not found') unless $account;
24
-
assert_repo_readable($c, $account);
22
+
my $account = _readable_repo($c, $c->param('repo'));
25
23
26
24
return {
27
25
handle => $account->{handle},
···
34
32
35
33
$registry->register('com.atproto.repo.createRecord', sub ($c, $endpoint) {
36
34
my $body = $c->req->json || {};
37
-
my $account = _require_repo_owner($c, $body->{repo});
38
-
my $commit = $c->repo_manager->apply_writes($account, [{
35
+
return _apply_single_write($c, $body, {
39
36
action => 'create',
40
37
collection => $body->{collection},
41
38
rkey => $body->{rkey},
42
39
value => $body->{record},
43
-
}], swap_commit => $body->{swapCommit});
44
-
my $result = $commit->{results}[0];
45
-
return {
46
-
%$result,
47
-
commit => {
48
-
cid => $commit->{cid},
49
-
rev => $commit->{rev},
50
-
},
51
-
};
40
+
}, include_result => 1);
52
41
});
53
42
54
43
$registry->register('com.atproto.repo.putRecord', sub ($c, $endpoint) {
55
44
my $body = $c->req->json || {};
56
-
my $account = _require_repo_owner($c, $body->{repo});
57
-
my $commit = $c->repo_manager->apply_writes($account, [{
45
+
return _apply_single_write($c, $body, {
58
46
action => 'update',
59
47
collection => $body->{collection},
60
48
rkey => $body->{rkey},
61
49
value => $body->{record},
62
-
}], swap_commit => $body->{swapCommit});
63
-
my $result = $commit->{results}[0];
64
-
return {
65
-
%$result,
66
-
commit => {
67
-
cid => $commit->{cid},
68
-
rev => $commit->{rev},
69
-
},
70
-
};
50
+
}, include_result => 1);
71
51
});
72
52
73
53
$registry->register('com.atproto.repo.deleteRecord', sub ($c, $endpoint) {
74
54
my $body = $c->req->json || {};
75
-
my $account = _require_repo_owner($c, $body->{repo});
76
-
my $commit = $c->repo_manager->apply_writes($account, [{
55
+
return _apply_single_write($c, $body, {
77
56
action => 'delete',
78
57
collection => $body->{collection},
79
58
rkey => $body->{rkey},
80
-
}], swap_commit => $body->{swapCommit});
81
-
return {
82
-
commit => {
83
-
cid => $commit->{cid},
84
-
rev => $commit->{rev},
85
-
},
86
-
};
59
+
});
87
60
});
88
61
89
62
$registry->register('com.atproto.repo.applyWrites', sub ($c, $endpoint) {
···
96
69
swap_commit => $body->{swapCommit},
97
70
);
98
71
return {
99
-
commit => {
100
-
cid => $commit->{cid},
101
-
rev => $commit->{rev},
102
-
},
72
+
commit => _commit_view($commit),
103
73
results => $commit->{results},
104
74
};
105
75
});
106
76
107
77
$registry->register('com.atproto.repo.getRecord', sub ($c, $endpoint) {
108
-
my $account = resolve_repo($c, $c->param('repo'));
109
-
xrpc_error(404, 'RepoNotFound', 'Repository was not found') unless $account;
110
-
assert_repo_readable($c, $account);
78
+
my $account = _readable_repo($c, $c->param('repo'));
111
79
my $row = $c->store->get_record($account->{did}, $c->param('collection'), $c->param('rkey'));
112
80
xrpc_error(404, 'RecordNotFound', 'Record was not found') unless $row;
113
-
assert_record_readable($c, "at://$account->{did}/$row->{collection}/$row->{rkey}");
114
-
return {
115
-
uri => "at://$account->{did}/$row->{collection}/$row->{rkey}",
116
-
cid => $row->{cid},
117
-
value => $row->{value},
118
-
};
81
+
assert_record_readable($c, _record_uri($account->{did}, $row->{collection}, $row->{rkey}));
82
+
return _record_view($account->{did}, $row);
119
83
});
120
84
121
85
$registry->register('com.atproto.repo.listRecords', sub ($c, $endpoint) {
122
-
my $account = resolve_repo($c, $c->param('repo'));
123
-
xrpc_error(404, 'RepoNotFound', 'Repository was not found') unless $account;
124
-
assert_repo_readable(
86
+
my $account = _readable_repo(
125
87
$c,
126
-
$account,
88
+
$c->param('repo'),
127
89
status => 400,
128
90
error => 'InvalidRequest',
129
91
message => 'Could not find repo: ' . ($c->param('repo') // q()),
···
138
100
);
139
101
return {
140
102
(defined $page->{cursor} ? (cursor => $page->{cursor}) : ()),
141
-
records => [
142
-
map {
143
-
+{
144
-
uri => "at://$account->{did}/$_->{collection}/$_->{rkey}",
145
-
cid => $_->{cid},
146
-
value => $_->{value},
147
-
}
148
-
} @{ $page->{items} }
149
-
],
103
+
records => [ map { _record_view($account->{did}, $_) } @{ $page->{items} } ],
150
104
};
151
105
});
152
106
···
218
172
xrpc_error(401, 'AuthRequired', 'Token is not authorized for that repo') unless ($claims->{sub} // '') eq $account->{did};
219
173
assert_repo_writable($c, $account);
220
174
return $account;
175
+
}
176
+
177
+
sub _readable_repo ($c, $repo, %args) {
178
+
my $account = resolve_repo($c, $repo);
179
+
xrpc_error(404, 'RepoNotFound', 'Repository was not found') unless $account;
180
+
assert_repo_readable($c, $account, %args);
181
+
return $account;
182
+
}
183
+
184
+
sub _apply_single_write ($c, $body, $write, %args) {
185
+
my $account = _require_repo_owner($c, $body->{repo});
186
+
my $commit = $c->repo_manager->apply_writes(
187
+
$account,
188
+
[$write],
189
+
swap_commit => $body->{swapCommit},
190
+
);
191
+
my %response = (
192
+
commit => _commit_view($commit),
193
+
);
194
+
if ($args{include_result}) {
195
+
my $result = $commit->{results}[0];
196
+
return {
197
+
%$result,
198
+
%response,
199
+
};
200
+
}
201
+
return \%response;
202
+
}
203
+
204
+
sub _commit_view ($commit) {
205
+
return {
206
+
cid => $commit->{cid},
207
+
rev => $commit->{rev},
208
+
};
209
+
}
210
+
211
+
sub _record_uri ($did, $collection, $rkey) {
212
+
return "at://$did/$collection/$rkey";
213
+
}
214
+
215
+
sub _record_view ($did, $row) {
216
+
return {
217
+
uri => _record_uri($did, $row->{collection}, $row->{rkey}),
218
+
cid => $row->{cid},
219
+
value => $row->{value},
220
+
};
221
221
}
222
222
223
223
sub _list_visible_records ($c, $did, $collection, %args) {
+15
-2
t/repo-api.t
+15
-2
t/repo-api.t
···
59
59
})->status_is(200)
60
60
->json_like('/cid' => qr/\Ab/);
61
61
62
+
$t->post_ok('/xrpc/com.atproto.repo.putRecord' => { Authorization => "Bearer $access" } => json => {
63
+
repo => $did,
64
+
collection => 'app.bsky.feed.post',
65
+
rkey => 'first-post',
66
+
record => {
67
+
'$type' => 'app.bsky.feed.post',
68
+
text => 'hello from updated perl',
69
+
createdAt => '2026-03-10T00:02:00Z',
70
+
},
71
+
})->status_is(200)
72
+
->json_is('/uri' => "at://$did/app.bsky.feed.post/first-post")
73
+
->json_like('/cid' => qr/\Ab/);
74
+
62
75
$t->post_ok('/xrpc/com.atproto.repo.createRecord' => { Authorization => "Bearer $refresh" } => json => {
63
76
repo => $did,
64
77
collection => 'app.bsky.feed.post',
···
73
86
74
87
$t->get_ok("/xrpc/com.atproto.repo.getRecord?repo=$did&collection=app.bsky.feed.post&rkey=first-post")
75
88
->status_is(200)
76
-
->json_is('/value/text' => 'hello from perl');
89
+
->json_is('/value/text' => 'hello from updated perl');
77
90
78
91
$t->get_ok("/xrpc/com.atproto.repo.listRecords?repo=$did&collection=app.bsky.feed.post")
79
92
->status_is(200)
80
-
->json_is('/records/0/value/text' => 'hello from perl');
93
+
->json_is('/records/0/value/text' => 'hello from updated perl');
81
94
82
95
$t->get_ok("/xrpc/com.atproto.sync.getLatestCommit?did=$did")
83
96
->status_is(200)