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(tempdir);
7use FindBin qw($Bin);
8use Test::More;
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 Test::Mojo;
21use JSON::PP ();
22use Mojo::URL;
23use ATProto::PDS;
24use ATProto::PDS::Repo::CAR qw(read_car);
25
26my $root = File::Spec->rel2abs(File::Spec->catdir($Bin, '..'));
27my $tmp = tempdir(CLEANUP => 1);
28
29my $app = ATProto::PDS->new(
30 project_root => $root,
31 settings => {
32 base_url => 'http://127.0.0.1:7755',
33 service_handle_domain => 'example.test',
34 service_did_method => 'did:web',
35 jwt_secret => 'surface-secret',
36 admin_password => 'admin-secret',
37 data_dir => File::Spec->catdir($tmp, 'data'),
38 db_path => File::Spec->catfile($tmp, 'perlsky.sqlite'),
39 },
40);
41
42my $t = Test::Mojo->new($app);
43my $admin_auth = 'Basic YWRtaW46YWRtaW4tc2VjcmV0';
44
45$t->post_ok('/xrpc/com.atproto.server.createAccount' => json => {
46 handle => 'alice.example.test',
47 email => 'alice@example.test',
48 password => 'hunter22',
49})->status_is(200);
50
51my $session = $t->tx->res->json;
52my $did = $session->{did};
53my $access = $session->{accessJwt};
54
55$t->post_ok('/xrpc/com.atproto.repo.createRecord' => { Authorization => "Bearer $access" } => json => {
56 repo => $did,
57 collection => 'app.bsky.feed.post',
58 rkey => 'hello-world',
59 record => {
60 '$type' => 'app.bsky.feed.post',
61 text => 'hello surface',
62 createdAt => '2026-03-10T00:00:00Z',
63 },
64})->status_is(200);
65
66my $record = $t->tx->res->json;
67my $record_uri = $record->{uri};
68my $record_cid = $record->{cid};
69
70$t->get_ok(Mojo::URL->new('/xrpc/com.atproto.sync.getLatestCommit')->query(
71 did => $did,
72))->status_is(200);
73
74my $latest = $t->tx->res->json;
75
76$t->get_ok(Mojo::URL->new('/xrpc/com.atproto.sync.getBlocks')->query(
77 did => $did,
78 cids => $latest->{cid},
79))->status_is(200)
80 ->content_type_like(qr{application/vnd\.ipld\.car})
81 ->content_like(qr/.+/s);
82my $blocks_car = read_car($t->tx->res->body);
83is_deeply($blocks_car->{roots}, [], 'sync.getBlocks returns a rootless CAR');
84ok(
85 scalar(grep { $_->{cid}->to_string eq $latest->{cid} } @{ $blocks_car->{blocks} || [] }),
86 'sync.getBlocks returns the requested repo-scoped block',
87);
88
89$t->post_ok('/xrpc/com.atproto.repo.uploadBlob' => {
90 Authorization => "Bearer $access",
91 'Content-Type' => 'text/plain',
92} => 'blob-bytes')->status_is(200);
93
94my $blob = $t->tx->res->json->{blob};
95my $blob_cid = $blob->{ref}{'$link'};
96
97$t->get_ok(Mojo::URL->new('/xrpc/com.atproto.sync.getBlob')->query(
98 did => $did,
99 cid => $blob_cid,
100))->status_is(400)
101 ->json_is('/error' => 'InvalidRequest');
102
103$t->post_ok('/xrpc/com.atproto.repo.createRecord' => {
104 Authorization => "Bearer $access",
105} => json => {
106 repo => $did,
107 collection => 'com.example.record',
108 rkey => 'missing-blob-ref',
109 record => {
110 '$type' => 'com.example.record',
111 note => 'blob reference for sync/blob surface listing',
112 image => $blob,
113 },
114})->status_is(200);
115
116$t->get_ok(Mojo::URL->new('/xrpc/com.atproto.sync.getBlob')->query(
117 did => $did,
118 cid => $blob_cid,
119))->status_is(200)
120 ->header_is('X-Content-Type-Options' => 'nosniff')
121 ->header_like('Content-Disposition' => qr/\Aattachment; filename="/)
122 ->header_is('Content-Security-Policy' => "default-src 'none'; sandbox")
123 ->content_type_is('text/plain')
124 ->content_is('blob-bytes');
125
126$t->post_ok('/xrpc/com.atproto.server.createAccount' => json => {
127 handle => 'bob.example.test',
128 email => 'bob@example.test',
129 password => 'hunter22',
130})->status_is(200);
131
132my $second = $t->tx->res->json;
133my $second_did = $second->{did};
134my $second_access = $second->{accessJwt};
135
136$t->post_ok('/xrpc/com.atproto.repo.uploadBlob' => {
137 Authorization => "Bearer $second_access",
138 'Content-Type' => 'text/plain',
139} => 'blob-bytes')->status_is(200)
140 ->json_is('/blob/ref/$link' => $blob_cid);
141
142$t->get_ok(Mojo::URL->new('/xrpc/com.atproto.sync.listBlobs')->query(
143 did => $did,
144))->status_is(200)
145 ->json_is('/cids/0' => $blob_cid);
146
147$t->get_ok(Mojo::URL->new('/xrpc/com.atproto.sync.listBlobs')->query(
148 did => $second_did,
149))->status_is(200)
150 ->json_is('/cids' => []);
151
152$t->get_ok(Mojo::URL->new('/xrpc/com.atproto.sync.getBlocks')->query(
153 did => $second_did,
154 cids => $latest->{cid},
155))->status_is(400)
156 ->json_is('/error' => 'InvalidRequest')
157 ->json_like('/message' => qr/\Q$latest->{cid}\E/);
158
159$t->post_ok('/xrpc/com.atproto.repo.uploadBlob' => {
160 Authorization => "Bearer $access",
161 'Content-Type' => 'text/plain',
162} => 'blob-two')->status_is(200);
163
164my $blob_two_cid = $t->tx->res->json->{blob}{ref}{'$link'};
165my @sorted_blob_cids = sort ($blob_cid, $blob_two_cid);
166
167$t->post_ok('/xrpc/com.atproto.repo.createRecord' => {
168 Authorization => "Bearer $access",
169} => json => {
170 repo => $did,
171 collection => 'com.example.record',
172 rkey => 'second-sync-blob-ref',
173 record => {
174 '$type' => 'com.example.record',
175 note => 'second blob reference for sync/blob surface listing',
176 image => {
177 '$type' => 'blob',
178 ref => { '$link' => $blob_two_cid },
179 mimeType => 'text/plain',
180 size => length('blob-two'),
181 },
182 },
183})->status_is(200);
184
185$t->get_ok(Mojo::URL->new('/xrpc/com.atproto.sync.listBlobs')->query(
186 did => $did,
187 limit => 1,
188))->status_is(200)
189 ->json_is('/cids/0' => $sorted_blob_cids[0])
190 ->json_is('/cursor' => $sorted_blob_cids[0]);
191
192$t->get_ok(Mojo::URL->new('/xrpc/com.atproto.sync.listBlobs')->query(
193 did => $did,
194 limit => 1,
195 cursor => $sorted_blob_cids[0],
196))->status_is(200)
197 ->json_is('/cids/0' => $sorted_blob_cids[1]);
198
199$t->get_ok(Mojo::URL->new('/xrpc/com.atproto.sync.getBlob')->query(
200 did => $second_did,
201 cid => $blob_cid,
202))->status_is(400)
203 ->json_is('/error' => 'InvalidRequest');
204
205my @since_sorted_blob_cids = sort ($blob_cid, $blob_two_cid);
206
207$t->get_ok(Mojo::URL->new('/xrpc/com.atproto.sync.listBlobs')->query(
208 did => $did,
209 since => $latest->{rev},
210))->status_is(200)
211 ->json_is('/cids/0' => $since_sorted_blob_cids[0])
212 ->json_is('/cids/1' => $since_sorted_blob_cids[1]);
213
214done_testing;