perlsky is a Perl 5 implementation of an AT Protocol Personal Data Server.
1use v5.34;
2use warnings;
3
4use Config ();
5use File::Spec;
6use File::Temp qw(tempfile);
7use FindBin qw($Bin);
8use Test2::V0;
9
10BEGIN {
11 require lib;
12 my $root = File::Spec->rel2abs(File::Spec->catdir($Bin, '..'));
13 lib->import(
14 File::Spec->catdir($root, 'lib'),
15 File::Spec->catdir($root, 'local', 'lib', 'perl5'),
16 File::Spec->catdir($root, 'local', 'lib', 'perl5', $Config::Config{archname}),
17 );
18}
19
20use ATProto::PDS::Repo::CAR qw(read_car write_car);
21use ATProto::PDS::Repo::CID;
22use ATProto::PDS::Repo::DagCbor qw(encode_dag_cbor);
23use ATProto::PDS::Store::SQLite;
24
25sub _upgrade_copy {
26 my ($bytes) = @_;
27 my $copy = $bytes;
28 utf8::upgrade($copy);
29 return $copy;
30}
31
32sub _mangle_copy {
33 my ($bytes) = @_;
34 my $copy = _upgrade_copy($bytes);
35 utf8::encode($copy);
36 return $copy;
37}
38
39my ($fh, $path) = tempfile();
40close $fh;
41
42my $store = ATProto::PDS::Store::SQLite->new(path => $path)->bootstrap;
43
44my $record = {
45 '$type' => 'app.bsky.feed.post',
46 text => 'sqlite binary roundtrip',
47 createdAt => '2026-03-11T02:00:00Z',
48};
49my $record_bytes = encode_dag_cbor($record);
50my $record_cid = ATProto::PDS::Repo::CID->for_dag_cbor($record_bytes);
51my $car_bytes = write_car($record_cid, [
52 { cid => $record_cid, bytes => $record_bytes },
53]);
54
55my $salt = pack('C*', map { 0x80 + $_ } 0 .. 15);
56my $private_key = pack('C*', map { 0x80 + $_ } 0 .. 31);
57my $public_key = pack('C*', map { 0x80 + $_ } 0 .. 64);
58my $label_sig = pack('C*', map { 0x80 + $_ } 0 .. 63);
59
60my $account = $store->create_account(
61 did => 'did:plc:sqlitebinary',
62 handle => 'sqlitebinary.test',
63 password_salt => _upgrade_copy($salt),
64 private_key => _upgrade_copy($private_key),
65 public_key => _upgrade_copy($public_key),
66 public_key_multibase => 'ztest',
67 signing_key_did => 'did:key:ztest',
68);
69
70ok(!utf8::is_utf8($account->{password_salt}), 'account salt is returned as raw bytes');
71ok(!utf8::is_utf8($account->{private_key}), 'account private key is returned as raw bytes');
72ok(!utf8::is_utf8($account->{public_key}), 'account public key is returned as raw bytes');
73is($account->{password_salt}, $salt, 'account salt roundtrips');
74is($account->{private_key}, $private_key, 'account private key roundtrips');
75is($account->{public_key}, $public_key, 'account public key roundtrips');
76
77$store->put_block(
78 cid => $record_cid->to_string,
79 codec => $record_cid->codec,
80 bytes => _upgrade_copy($record_bytes),
81);
82my $block = $store->get_block($record_cid->to_string);
83ok(!utf8::is_utf8($block->{bytes}), 'block bytes are returned as raw bytes');
84is($block->{bytes}, $record_bytes, 'block bytes roundtrip');
85
86$store->put_record(
87 did => $account->{did},
88 collection => 'app.bsky.feed.post',
89 rkey => 'abc',
90 cid => $record_cid->to_string,
91 value => $record,
92 record_bytes => _upgrade_copy($record_bytes),
93);
94my $stored_record = $store->get_record($account->{did}, 'app.bsky.feed.post', 'abc');
95ok(!utf8::is_utf8($stored_record->{record_bytes}), 'record bytes are returned as raw bytes');
96is($stored_record->{record_bytes}, $record_bytes, 'record bytes roundtrip');
97
98$store->put_commit(
99 did => $account->{did},
100 rev => 'rev1',
101 cid => $record_cid->to_string,
102 root_cid => $record_cid->to_string,
103 commit_bytes => _upgrade_copy($record_bytes),
104 car_bytes => _upgrade_copy($car_bytes),
105);
106my $commit = $store->get_latest_commit($account->{did});
107ok(!utf8::is_utf8($commit->{commit_bytes}), 'commit bytes are returned as raw bytes');
108ok(!utf8::is_utf8($commit->{car_bytes}), 'commit CAR is returned as raw bytes');
109is($commit->{commit_bytes}, $record_bytes, 'commit bytes roundtrip');
110is($commit->{car_bytes}, $car_bytes, 'commit CAR roundtrip');
111
112$store->append_event(
113 did => $account->{did},
114 type => 'commit',
115 rev => 'rev1',
116 commit_cid => $record_cid->to_string,
117 payload => { ops => [] },
118 car_bytes => _upgrade_copy($car_bytes),
119);
120my $event = $store->list_events_after(0)->[0];
121ok(!utf8::is_utf8($event->{car_bytes}), 'event CAR is returned as raw bytes');
122is($event->{car_bytes}, $car_bytes, 'event CAR roundtrip');
123is(read_car($event->{car_bytes})->{roots}[0]->to_string, $record_cid->to_string, 'roundtripped event CAR remains parseable');
124
125my ($repair_fh, $repair_path) = tempfile();
126close $repair_fh;
127my $repair_store = ATProto::PDS::Store::SQLite->new(path => $repair_path)->bootstrap;
128my $repair_account = $repair_store->create_account(
129 did => 'did:plc:repairbinary',
130 handle => 'repairbinary.test',
131 password_salt => $salt,
132 private_key => $private_key,
133 public_key => $public_key,
134 public_key_multibase => 'zrepair',
135 signing_key_did => 'did:key:zrepair',
136);
137
138my $dbh = $repair_store->dbh;
139my $mangled_salt = _mangle_copy($salt);
140my $mangled_private_key = _mangle_copy($private_key);
141my $mangled_public_key = _mangle_copy($public_key);
142my $mangled_record = _mangle_copy($record_bytes);
143my $mangled_car = _mangle_copy($car_bytes);
144
145$dbh->do(
146 q{UPDATE accounts SET password_salt = ?, private_key = ?, public_key = ? WHERE did = ?},
147 undef,
148 $mangled_salt,
149 $mangled_private_key,
150 $mangled_public_key,
151 $repair_account->{did},
152);
153$dbh->do(
154 q{INSERT INTO blocks (cid, codec, bytes, created_at) VALUES (?, ?, ?, ?)},
155 undef,
156 $record_cid->to_string,
157 $record_cid->codec,
158 $mangled_record,
159 time,
160);
161$dbh->do(
162 q{INSERT INTO records (did, collection, rkey, cid, value_json, record_bytes, created_at, updated_at) VALUES (?, ?, ?, ?, ?, ?, ?, ?)},
163 undef,
164 $repair_account->{did},
165 'app.bsky.feed.post',
166 'repair',
167 $record_cid->to_string,
168 '{"text":"repair"}',
169 $mangled_record,
170 time,
171 time,
172);
173$dbh->do(
174 q{INSERT INTO commits (did, rev, cid, root_cid, prev_cid, commit_bytes, car_bytes, created_at) VALUES (?, ?, ?, ?, ?, ?, ?, ?)},
175 undef,
176 $repair_account->{did},
177 'rev2',
178 $record_cid->to_string,
179 $record_cid->to_string,
180 undef,
181 $mangled_record,
182 $mangled_car,
183 time,
184);
185$dbh->do(
186 q{INSERT INTO events (did, type, rev, commit_cid, payload_json, car_bytes, created_at) VALUES (?, ?, ?, ?, ?, ?, ?)},
187 undef,
188 $repair_account->{did},
189 'commit',
190 'rev2',
191 $record_cid->to_string,
192 '{"ops":[]}',
193 $mangled_car,
194 time,
195);
196$dbh->do(
197 q{INSERT INTO labels (subject_key, src, uri, cid, val, exp, sig, created_at, updated_at) VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?)},
198 undef,
199 'at://did:plc:repairbinary/app.bsky.feed.post/repair',
200 'did:plc:repairbinary',
201 'at://did:plc:repairbinary/app.bsky.feed.post/repair',
202 $record_cid->to_string,
203 '!hide',
204 undef,
205 _mangle_copy($label_sig),
206 time,
207 time,
208);
209
210my $counts = $repair_store->repair_binary_columns;
211cmp_ok($counts->{accounts}, '>=', 1, 'repair updated account blobs');
212cmp_ok($counts->{blocks}, '>=', 1, 'repair updated block blobs');
213cmp_ok($counts->{records}, '>=', 1, 'repair updated record blobs');
214cmp_ok($counts->{commits}, '>=', 1, 'repair updated commit blobs');
215cmp_ok($counts->{events}, '>=', 1, 'repair updated event blobs');
216cmp_ok($counts->{labels}, '>=', 1, 'repair updated label signatures');
217
218my $repaired_account = $repair_store->get_account_by_did($repair_account->{did});
219is($repaired_account->{password_salt}, $salt, 'repair restored account salt');
220is($repaired_account->{private_key}, $private_key, 'repair restored account private key');
221is($repaired_account->{public_key}, $public_key, 'repair restored account public key');
222is($repair_store->get_block($record_cid->to_string)->{bytes}, $record_bytes, 'repair restored block bytes');
223is($repair_store->get_record($repair_account->{did}, 'app.bsky.feed.post', 'repair')->{record_bytes}, $record_bytes, 'repair restored record bytes');
224is($repair_store->get_latest_commit($repair_account->{did})->{car_bytes}, $car_bytes, 'repair restored commit CAR');
225is($repair_store->list_events_after(0)->[0]{car_bytes}, $car_bytes, 'repair restored event CAR');
226is($repair_store->get_label(subject_key => 'at://did:plc:repairbinary/app.bsky.feed.post/repair', src => 'did:plc:repairbinary', val => '!hide')->{sig}, $label_sig, 'repair restored label signature bytes');
227
228done_testing;