perlsky is a Perl 5 implementation of an AT Protocol Personal Data Server.
Honor repo record CIDs and swaps
+103
-14
+18
-1
lib/ATProto/PDS/API/Repo.pm
+18
-1
lib/ATProto/PDS/API/Repo.pm
···
80
80
return undef;
81
81
}
82
82
assert_repo_readable($c, $account);
83
-
my $row = $c->store->get_record($account->{did}, $c->param('collection'), $c->param('rkey'));
83
+
my $row = $c->store->get_record(
84
+
$account->{did},
85
+
$c->param('collection'),
86
+
$c->param('rkey'),
87
+
$c->param('cid'),
88
+
);
84
89
xrpc_error(404, 'RecordNotFound', 'Record was not found') unless $row;
85
90
assert_record_readable($c, _record_uri($account->{did}, $row->{collection}, $row->{rkey}));
86
91
return _record_view($account->{did}, $row);
···
317
322
collection => $collection,
318
323
rkey => $rkey,
319
324
value => $body->{record},
325
+
(exists $body->{swapRecord}
326
+
? (
327
+
swap_record_present => 1,
328
+
swap_record => $body->{swapRecord},
329
+
)
330
+
: ()),
320
331
}],
321
332
swap_commit => $body->{swapCommit},
322
333
);
···
340
351
action => 'delete',
341
352
collection => $body->{collection},
342
353
rkey => $body->{rkey},
354
+
(exists $body->{swapRecord}
355
+
? (
356
+
swap_record_present => 1,
357
+
swap_record => $body->{swapRecord},
358
+
)
359
+
: ()),
343
360
}],
344
361
swap_commit => $body->{swapCommit},
345
362
);
+22
lib/ATProto/PDS/Repo/Manager.pm
+22
lib/ATProto/PDS/Repo/Manager.pm
···
89
89
my $rkey = $write->{rkey} // next_tid();
90
90
my $path = $collection . '/' . $rkey;
91
91
my $previous = $previous_records{$path};
92
+
my $current_cid = $previous ? $previous->{cid} : undef;
93
+
94
+
if ($write->{swap_record_present}) {
95
+
my $swap_record = $write->{swap_record};
96
+
die {
97
+
status => 400,
98
+
error => 'InvalidSwap',
99
+
message => 'swapRecord did not match the current record',
100
+
} if $action eq 'create' && defined $swap_record;
101
+
die {
102
+
status => 400,
103
+
error => 'InvalidSwap',
104
+
message => 'swapRecord did not match the current record',
105
+
} if ($action eq 'update' || $action eq 'delete') && !defined $swap_record;
106
+
my $mismatch = (defined($current_cid) || defined($swap_record))
107
+
&& (!defined($current_cid) || !defined($swap_record) || $current_cid ne $swap_record);
108
+
die {
109
+
status => 400,
110
+
error => 'InvalidSwap',
111
+
message => 'swapRecord did not match the current record',
112
+
} if $mismatch;
113
+
}
92
114
93
115
if ($action eq 'delete') {
94
116
xrpc_error(400, 'InvalidRequest', 'Could not locate record: at://' . $did . '/' . $path)
+12
-8
lib/ATProto/PDS/Store/SQLite.pm
+12
-8
lib/ATProto/PDS/Store/SQLite.pm
···
895
895
return 1;
896
896
}
897
897
898
-
sub get_record ($self, $did, $collection, $rkey) {
898
+
sub get_record ($self, $did, $collection, $rkey, $cid = undef) {
899
+
my @bind = ($did, $collection, $rkey);
900
+
my $sql = q{
901
+
SELECT * FROM records
902
+
WHERE did = ? AND collection = ? AND rkey = ?
903
+
};
904
+
if (defined $cid && length $cid) {
905
+
$sql .= q{ AND cid = ?};
906
+
push @bind, $cid;
907
+
}
899
908
my $row = $self->dbh->selectrow_hashref(
900
-
q{
901
-
SELECT * FROM records
902
-
WHERE did = ? AND collection = ? AND rkey = ?
903
-
},
909
+
$sql,
904
910
undef,
905
-
$did,
906
-
$collection,
907
-
$rkey,
911
+
@bind,
908
912
);
909
913
return _row_to_record($row);
910
914
}
+51
-5
t/repo-api.t
+51
-5
t/repo-api.t
···
164
164
->status_is(200)
165
165
->json_is('/value/text' => 'put created this record');
166
166
167
+
$t->get_ok("/xrpc/com.atproto.repo.getRecord?repo=$did&collection=app.bsky.feed.post&rkey=first-post&cid=$updated_cid")
168
+
->status_is(200)
169
+
->json_is('/cid' => $updated_cid)
170
+
->json_is('/value/text' => 'hello from updated perl');
171
+
172
+
$t->get_ok("/xrpc/com.atproto.repo.getRecord?repo=$did&collection=app.bsky.feed.post&rkey=first-post&cid=bafyreifakecidmismatch")
173
+
->status_is(404)
174
+
->json_is('/error' => 'RecordNotFound');
175
+
176
+
$t->post_ok('/xrpc/com.atproto.repo.putRecord' => { Authorization => "Bearer $access" } => json => {
177
+
repo => $did,
178
+
collection => 'app.bsky.feed.post',
179
+
rkey => 'first-post',
180
+
swapRecord => 'bafyreifakecidmismatch',
181
+
record => {
182
+
'$type' => 'app.bsky.feed.post',
183
+
text => 'swap mismatch should fail',
184
+
createdAt => '2026-03-10T00:03:00Z',
185
+
},
186
+
})->status_is(400)
187
+
->json_is('/error' => 'InvalidSwap');
188
+
189
+
$t->post_ok('/xrpc/com.atproto.repo.putRecord' => { Authorization => "Bearer $access" } => json => {
190
+
repo => $did,
191
+
collection => 'app.bsky.feed.post',
192
+
rkey => 'first-post',
193
+
swapRecord => $updated_cid,
194
+
record => {
195
+
'$type' => 'app.bsky.feed.post',
196
+
text => 'hello from swapped perl',
197
+
createdAt => '2026-03-10T00:03:00Z',
198
+
},
199
+
})->status_is(200)
200
+
->json_is('/uri' => "at://$did/app.bsky.feed.post/first-post")
201
+
->json_like('/cid' => qr/\Ab/);
202
+
my $swapped_cid = $t->tx->res->json->{cid};
203
+
167
204
$t->get_ok('/xrpc/com.atproto.repo.getRecord?repo=did:plc:by3jhwdqgbtrcc7q4tkkv3cf&collection=app.bsky.feed.post&rkey=3mgsm5nr5i22a')
168
205
->status_is(200)
169
206
->header_is('ETag' => 'W/"remote-record"')
···
198
235
199
236
$t->get_ok("/xrpc/com.atproto.repo.getRecord?repo=$did&collection=app.bsky.feed.post&rkey=first-post")
200
237
->status_is(200)
201
-
->json_is('/value/text' => 'hello from updated perl');
238
+
->json_is('/value/text' => 'hello from swapped perl');
202
239
203
240
$t->get_ok("/xrpc/com.atproto.repo.listRecords?repo=$did&collection=app.bsky.feed.post")
204
241
->status_is(200)
205
242
->json_is('/records/0/value/text' => 'put created this record')
206
-
->json_is('/records/1/value/text' => 'hello from updated perl');
243
+
->json_is('/records/1/value/text' => 'hello from swapped perl');
207
244
208
245
$t->get_ok('/xrpc/com.atproto.repo.listRecords?repo=Repo-Owner.Localhost&collection=app.bsky.feed.post')
209
246
->status_is(200)
210
247
->json_is('/records/0/value/text' => 'put created this record')
211
-
->json_is('/records/1/value/text' => 'hello from updated perl');
248
+
->json_is('/records/1/value/text' => 'hello from swapped perl');
212
249
213
250
$t->get_ok("/xrpc/com.atproto.sync.getLatestCommit?did=$did")
214
251
->status_is(200)
···
222
259
my $record_proof = read_car($t->tx->res->body);
223
260
is($record_proof->{roots}[0]->to_string, $latest_commit_cid, 'sync.getRecord roots the latest commit');
224
261
ok(
225
-
scalar(grep { $_->{cid}->to_string eq $updated_cid } @{ $record_proof->{blocks} || [] }),
262
+
scalar(grep { $_->{cid}->to_string eq $swapped_cid } @{ $record_proof->{blocks} || [] }),
226
263
'sync.getRecord proof includes the current record block',
227
264
);
228
265
···
253
290
repo => $did,
254
291
collection => 'app.bsky.feed.post',
255
292
rkey => 'first-post',
293
+
swapRecord => $updated_cid,
294
+
})->status_is(400)
295
+
->json_is('/error' => 'InvalidSwap');
296
+
297
+
$t->post_ok('/xrpc/com.atproto.repo.deleteRecord' => { Authorization => "Bearer $access" } => json => {
298
+
repo => $did,
299
+
collection => 'app.bsky.feed.post',
300
+
rkey => 'first-post',
301
+
swapRecord => $swapped_cid,
256
302
})->status_is(200);
257
303
258
304
$t->get_ok("/xrpc/com.atproto.repo.getRecord?repo=$did&collection=app.bsky.feed.post&rkey=first-post")
···
265
311
my $missing_record_proof = read_car($t->tx->res->body);
266
312
ok(@{ $missing_record_proof->{blocks} || [] } >= 2, 'missing sync proof still includes commit and MST blocks');
267
313
ok(
268
-
!scalar(grep { $_->{cid}->to_string eq $updated_cid } @{ $missing_record_proof->{blocks} || [] }),
314
+
!scalar(grep { $_->{cid}->to_string eq $swapped_cid } @{ $missing_record_proof->{blocks} || [] }),
269
315
'missing sync proof omits the deleted record block',
270
316
);
271
317