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 ATProto::PDS;
21use ATProto::PDS::Repo::CAR qw(read_car);
22
23my $root = File::Spec->rel2abs(File::Spec->catdir($Bin, '..'));
24my $tmp = tempdir(CLEANUP => 1);
25
26my $app = ATProto::PDS->new(
27 project_root => $root,
28 settings => {
29 base_url => 'http://127.0.0.1:7755',
30 service_handle_domain => 'example.test',
31 service_did_method => 'did:web',
32 jwt_secret => 'repo-firehose-secret',
33 admin_password => 'admin-secret',
34 data_dir => File::Spec->catdir($tmp, 'data'),
35 db_path => File::Spec->catfile($tmp, 'perlsky.sqlite'),
36 },
37);
38
39my $keys = $app->repo_manager->generate_signing_key;
40my $account = $app->store->create_account(
41 account_id => 'acct-1',
42 did => 'did:plc:repofirehosecartestacct',
43 handle => 'alice.example.test',
44 private_key => $keys->{private_key},
45 public_key => $keys->{public_key},
46 public_key_multibase => $keys->{public_key_multibase},
47 signing_key_did => $keys->{signing_key_did},
48);
49
50my $init = $app->repo_manager->initialize_repo($account);
51$account = $app->store->update_account(
52 $account->{did},
53 repo_commit_cid => $init->{cid},
54 repo_root_cid => $init->{root_cid},
55 repo_rev => $init->{rev},
56);
57
58my $first = $app->repo_manager->apply_writes($account, [{
59 action => 'create',
60 collection => 'app.bsky.feed.post',
61 rkey => 'first',
62 value => {
63 '$type' => 'app.bsky.feed.post',
64 text => 'first post',
65 createdAt => '2026-03-11T00:00:00Z',
66 },
67}]);
68
69my $first_cid = $first->{results}[0]{cid};
70my $first_car = read_car($first->{car_bytes});
71ok(
72 scalar(grep { $_->{cid}->to_string eq $first_cid } @{ $first_car->{blocks} || [] }),
73 'first firehose CAR includes the created record block',
74);
75
76my $second = $app->repo_manager->apply_writes($account, [{
77 action => 'create',
78 collection => 'app.bsky.feed.post',
79 rkey => 'second',
80 value => {
81 '$type' => 'app.bsky.feed.post',
82 text => 'second post',
83 createdAt => '2026-03-11T00:00:01Z',
84 },
85}]);
86
87my $second_cid = $second->{results}[0]{cid};
88my $second_car = read_car($second->{car_bytes});
89ok(
90 scalar(grep { $_->{cid}->to_string eq $second_cid } @{ $second_car->{blocks} || [] }),
91 'second firehose CAR includes the new record block',
92);
93ok(
94 !scalar(grep { $_->{cid}->to_string eq $first_cid } @{ $second_car->{blocks} || [] }),
95 'second firehose CAR does not resend the unchanged first record block',
96);
97
98my $snapshot_car = read_car($app->store->repo_car($account->{did}));
99ok(
100 scalar(grep { $_->{cid}->to_string eq $first_cid } @{ $snapshot_car->{blocks} || [] }),
101 'repo snapshot CAR still includes the first record block',
102);
103ok(
104 scalar(grep { $_->{cid}->to_string eq $second_cid } @{ $snapshot_car->{blocks} || [] }),
105 'repo snapshot CAR still includes the second record block',
106);
107
108done_testing;