perlsky is a Perl 5 implementation of an AT Protocol Personal Data Server.
Split importRepo policy coverage from conformance suite
+60
-33
+3
-2
docs/TEST_AUDIT.md
+3
-2
docs/TEST_AUDIT.md
···
116
116
Current suite counts by bucket:
117
117
118
118
- `direct reference differential`: `5`
119
-
- `audited local regression`: `30`
119
+
- `audited local regression`: `31`
120
120
- `local correctness/infrastructure`: `13`
121
121
122
122
| Test file | Bucket | Current note |
···
141
141
| `t/external-surface.t` | audited local regression | mixes reference-aligned repo/sync/blob/account-status behavior with local-only surfaces such as `resolveLexicon`, `checkHandleAvailability`, and `listReposByCollection`; intentionally broad, with order-insensitive label assertions rather than brittle ordering |
142
142
| `t/firehose.t` | audited local regression | repo subscription lifecycle, cursor, and CAR behavior |
143
143
| `t/identity.t` | local correctness/infrastructure | lower-level handle and DID helper coverage, including DNS-over-well-known preference and malformed-handle rejection |
144
-
| `t/import-repo.t` | audited local regression | mostly reference-aligned `importRepo` snapshot-restore and rollback behavior, plus one local policy assertion for the disabled-import service gate |
144
+
| `t/import-repo.t` | audited local regression | focused `importRepo` snapshot-restore and rollback behavior, now cleaner after splitting the disabled-import policy gate into its own suite |
145
+
| `t/import-repo-policy.t` | audited local regression | local service-policy coverage for the `accepting_imports` gate on `importRepo` |
145
146
| `t/invite-gating.t` | audited local regression | self-service invite flag behavior |
146
147
| `t/ipld-canonical.t` | local correctness/infrastructure | canonical IPLD encoding invariants |
147
148
| `t/ipld-codecs.t` | local correctness/infrastructure | DAG-CBOR and codec coverage |
+57
t/import-repo-policy.t
+57
t/import-repo-policy.t
···
1
+
use v5.34;
2
+
use warnings;
3
+
4
+
use Config ();
5
+
use File::Spec;
6
+
use File::Temp qw(tempdir);
7
+
use FindBin qw($Bin);
8
+
use Test::More;
9
+
10
+
BEGIN {
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
+
20
+
use Test::Mojo;
21
+
use ATProto::PDS;
22
+
23
+
my $root = File::Spec->rel2abs(File::Spec->catdir($Bin, '..'));
24
+
my $tmp = tempdir(CLEANUP => 1);
25
+
26
+
my $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
+
accepting_imports => 0,
33
+
jwt_secret => 'import-disabled-secret',
34
+
admin_password => 'admin-secret',
35
+
data_dir => File::Spec->catdir($tmp, 'data'),
36
+
db_path => File::Spec->catfile($tmp, 'perlsky.sqlite'),
37
+
},
38
+
);
39
+
40
+
my $t = Test::Mojo->new($app);
41
+
42
+
$t->post_ok('/xrpc/com.atproto.server.createAccount' => json => {
43
+
handle => 'carol.example.test',
44
+
email => 'carol@example.test',
45
+
password => 'hunter22',
46
+
})->status_is(200);
47
+
48
+
my $access = $t->tx->res->json->{accessJwt};
49
+
50
+
$t->post_ok('/xrpc/com.atproto.repo.importRepo' => {
51
+
Authorization => "Bearer $access",
52
+
'Content-Type' => 'application/vnd.ipld.car',
53
+
} => 'x')->status_is(400)
54
+
->json_is('/error' => 'InvalidRequest')
55
+
->json_is('/message' => 'Service is not accepting repo imports');
56
+
57
+
done_testing;
-31
t/import-repo.t
-31
t/import-repo.t
···
119
119
'importRepo drops writes that happened after the imported snapshot',
120
120
);
121
121
122
-
my $disabled_tmp = tempdir(CLEANUP => 1);
123
-
my $disabled_app = ATProto::PDS->new(
124
-
project_root => $root,
125
-
settings => {
126
-
base_url => 'http://127.0.0.1:7755',
127
-
service_handle_domain => 'example.test',
128
-
service_did_method => 'did:web',
129
-
accepting_imports => 0,
130
-
jwt_secret => 'import-disabled-secret',
131
-
admin_password => 'admin-secret',
132
-
data_dir => File::Spec->catdir($disabled_tmp, 'data'),
133
-
db_path => File::Spec->catfile($disabled_tmp, 'perlsky.sqlite'),
134
-
},
135
-
);
136
-
my $disabled_t = Test::Mojo->new($disabled_app);
137
-
138
-
$disabled_t->post_ok('/xrpc/com.atproto.server.createAccount' => json => {
139
-
handle => 'carol.example.test',
140
-
email => 'carol@example.test',
141
-
password => 'hunter22',
142
-
})->status_is(200);
143
-
144
-
my $disabled_access = $disabled_t->tx->res->json->{accessJwt};
145
-
146
-
$disabled_t->post_ok('/xrpc/com.atproto.repo.importRepo' => {
147
-
Authorization => "Bearer $disabled_access",
148
-
'Content-Type' => 'application/vnd.ipld.car',
149
-
} => 'x')->status_is(400)
150
-
->json_is('/error' => 'InvalidRequest')
151
-
->json_is('/message' => 'Service is not accepting repo imports');
152
-
153
122
done_testing;