perlsky is a Perl 5 implementation of an AT Protocol Personal Data Server.
Split account status checks from external surface suite
+130
-66
+5
-4
docs/TEST_AUDIT.md
+5
-4
docs/TEST_AUDIT.md
···
13
13
The current baseline for saying "the audited suite is green" is:
14
14
15
15
- `prove -lr t`
16
-
- latest full green result in the realigned Meridian worktree: `Files=58, Tests=3053`
16
+
- latest full green result in the realigned Meridian worktree: `Files=59, Tests=3057`
17
17
- `prove -lv t/server-auth.t`
18
18
- `perl -c script/differential-validate`
19
19
- `PERLSKY_RUN_REFERENCE_DIFF=1 prove -lv t/reference-differential.t`
···
116
116
Current suite counts by bucket:
117
117
118
118
- `direct reference differential`: `5`
119
-
- `audited local regression`: `40`
119
+
- `audited local regression`: `41`
120
120
- `local correctness/infrastructure`: `13`
121
121
122
122
| Test file | Bucket | Current note |
···
127
127
| `t/app.t` | audited local regression | application bootstrap plus malformed-handle rejection and startup hardening |
128
128
| `t/admin-account-surfaces.t` | audited local regression | isolated admin account-maintenance coverage for handle/email/password/signing-key/send-email/subject-status behaviors |
129
129
| `t/account-self-service-surfaces.t` | audited local regression | isolated self-service account maintenance coverage for admin account lookup, identity refresh/update, and email update/confirmation flows |
130
+
| `t/account-status-surfaces.t` | audited local regression | isolated account-status and DID-doc validation coverage for `checkAccountStatus` and admin account lookup |
130
131
| `t/account-migration-auth.t` | audited local regression | explicit-`did` account creation requires authenticated migration service-auth and preserves remote DID-doc state while starting deactivated |
131
132
| `t/auth-jwt.t` | local correctness/infrastructure | JWT signing and validation behavior |
132
133
| `t/blob-sync-surfaces.t` | audited local regression | isolated blob upload and sync happy-path coverage for `uploadBlob`, `listBlobs`, `getBlob`, `getLatestCommit`, and `getBlocks` |
···
142
143
| `t/event-stream.t` | audited local regression | wire-format, malformed frame, and event decoding coverage |
143
144
| `t/extended-api.t` | audited local regression | focused `applyWrites` happy-path and missing-delete behavior after the self-service invite, identity/email, label, and blob/sync happy paths were split out |
144
145
| `t/external-handle-update.t` | audited local regression | external-handle update semantics, including DID-resolution checks and empty-body success for external handle adoption |
145
-
| `t/external-surface.t` | audited local regression | focused external-surface coverage for repo/blob/account-status and missing-blob behavior after splitting discovery and label RPC checks into dedicated suites |
146
+
| `t/external-surface.t` | audited local regression | focused external-surface coverage for repo/blob export and missing-blob behavior after splitting discovery, label RPC, and account-status checks into dedicated suites |
146
147
| `t/firehose.t` | audited local regression | repo subscription lifecycle, cursor, and CAR behavior |
147
148
| `t/identity.t` | local correctness/infrastructure | lower-level handle and DID helper coverage, including DNS-over-well-known preference and malformed-handle rejection |
148
149
| `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 |
···
187
188
- `t/extended-api.t`
188
189
Carries real conformance value for `applyWrites`, but it is now much narrower and mostly acts as a focused repo-write regression suite.
189
190
- `t/external-surface.t`
190
-
Carries strong external-surface coverage for repo export, blob access, account-status behavior, and missing-blob listing. It is cleaner after moving discovery and label-RPC checks into dedicated suites, but still remains broader than a single-endpoint conformance file.
191
+
Carries strong external-surface coverage for repo/blob export and missing-blob listing. It is cleaner after moving discovery, label-RPC, and account-status checks into dedicated suites, but still remains broader than a single-endpoint conformance file.
191
192
- `t/uncovered-endpoints.t`
192
193
Exists specifically to stop a few lesser-used local endpoints from falling out of coverage; it is much narrower now that the temp, invite, and admin-account blocks have moved into dedicated suites, but it should still be read as a pragmatic safety net, not as a pure reference-alignment suite.
193
194
+125
t/account-status-surfaces.t
+125
t/account-status-surfaces.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 JSON::PP ();
9
+
use Test::More;
10
+
11
+
BEGIN {
12
+
require lib;
13
+
my $root = File::Spec->rel2abs(File::Spec->catdir($Bin, '..'));
14
+
lib->import(
15
+
File::Spec->catdir($root, 'lib'),
16
+
File::Spec->catdir($root, 'local', 'lib', 'perl5'),
17
+
File::Spec->catdir($root, 'local', 'lib', 'perl5', $Config::Config{archname}),
18
+
);
19
+
}
20
+
21
+
use Test::Mojo;
22
+
use Mojo::URL;
23
+
use ATProto::PDS;
24
+
25
+
my $root = File::Spec->rel2abs(File::Spec->catdir($Bin, '..'));
26
+
my $tmp = tempdir(CLEANUP => 1);
27
+
28
+
my $app = ATProto::PDS->new(
29
+
project_root => $root,
30
+
settings => {
31
+
base_url => 'http://127.0.0.1:7755',
32
+
service_handle_domain => 'example.test',
33
+
service_did_method => 'did:web',
34
+
jwt_secret => 'account-status-secret',
35
+
admin_password => 'admin-secret',
36
+
data_dir => File::Spec->catdir($tmp, 'data'),
37
+
db_path => File::Spec->catfile($tmp, 'perlsky.sqlite'),
38
+
},
39
+
);
40
+
41
+
my $t = Test::Mojo->new($app);
42
+
my $admin_auth = 'Basic YWRtaW46YWRtaW4tc2VjcmV0';
43
+
44
+
$t->post_ok('/xrpc/com.atproto.server.createAccount' => json => {
45
+
handle => 'alice.example.test',
46
+
email => 'alice@example.test',
47
+
password => 'hunter22',
48
+
})->status_is(200);
49
+
50
+
my $session = $t->tx->res->json;
51
+
my $did = $session->{did};
52
+
my $access = $session->{accessJwt};
53
+
54
+
$t->post_ok('/xrpc/com.atproto.server.createAccount' => json => {
55
+
handle => 'bob.example.test',
56
+
email => 'bob@example.test',
57
+
password => 'hunter22',
58
+
})->status_is(200);
59
+
60
+
my $second = $t->tx->res->json;
61
+
my $second_access = $second->{accessJwt};
62
+
63
+
$t->get_ok('/xrpc/com.atproto.server.checkAccountStatus' => {
64
+
Authorization => "Bearer $access",
65
+
})->status_is(200)
66
+
->json_has('/activated')
67
+
->json_is('/validDid' => JSON::PP::true)
68
+
->json_has('/repoCommit')
69
+
->json_has('/repoRev')
70
+
->json_has('/repoBlocks')
71
+
->json_has('/indexedRecords')
72
+
->json_has('/expectedBlobs')
73
+
->json_has('/importedBlobs');
74
+
75
+
my $account = $app->store->get_account_by_did($did);
76
+
my $original_did_doc = $account->{did_doc};
77
+
78
+
my %bad_endpoint_doc = %{$original_did_doc};
79
+
$bad_endpoint_doc{service} = [
80
+
map {
81
+
my %copy = %{$_};
82
+
$copy{serviceEndpoint} = 'https://elsewhere.example'
83
+
if ($copy{id} // q()) eq "$did#atproto_pds";
84
+
\%copy;
85
+
} @{ $original_did_doc->{service} || [] }
86
+
];
87
+
$app->store->update_account($did, did_doc => \%bad_endpoint_doc);
88
+
89
+
$t->get_ok('/xrpc/com.atproto.server.checkAccountStatus' => {
90
+
Authorization => "Bearer $access",
91
+
})->status_is(200)
92
+
->json_is('/validDid' => JSON::PP::false);
93
+
94
+
my %bad_key_doc = %{$original_did_doc};
95
+
$bad_key_doc{verificationMethod} = [
96
+
map {
97
+
my %copy = %{$_};
98
+
$copy{publicKeyMultibase} = 'zQmInvalidSigningKey'
99
+
if ($copy{id} // q()) eq "$did#atproto";
100
+
\%copy;
101
+
} @{ $original_did_doc->{verificationMethod} || [] }
102
+
];
103
+
$app->store->update_account($did, did_doc => \%bad_key_doc);
104
+
105
+
$t->get_ok('/xrpc/com.atproto.server.checkAccountStatus' => {
106
+
Authorization => "Bearer $access",
107
+
})->status_is(200)
108
+
->json_is('/validDid' => JSON::PP::false);
109
+
110
+
$app->store->update_account($did, did_doc => $original_did_doc);
111
+
112
+
$t->get_ok('/xrpc/com.atproto.server.checkAccountStatus' => {
113
+
Authorization => "Bearer $second_access",
114
+
})->status_is(200)
115
+
->json_is('/expectedBlobs' => 0)
116
+
->json_is('/importedBlobs' => 0);
117
+
118
+
$t->get_ok(Mojo::URL->new('/xrpc/com.atproto.admin.getAccountInfo')->query(
119
+
did => $did,
120
+
) => {
121
+
Authorization => $admin_auth,
122
+
})->status_is(200)
123
+
->json_is('/handle' => 'alice.example.test');
124
+
125
+
done_testing;
-62
t/external-surface.t
-62
t/external-surface.t
···
216
216
->json_is('/cids/0' => $since_sorted_blob_cids[0])
217
217
->json_is('/cids/1' => $since_sorted_blob_cids[1]);
218
218
219
-
$t->get_ok('/xrpc/com.atproto.server.checkAccountStatus' => {
220
-
Authorization => "Bearer $access",
221
-
})->status_is(200)
222
-
->json_has('/activated')
223
-
->json_is('/validDid' => JSON::PP::true)
224
-
->json_has('/repoCommit')
225
-
->json_has('/repoRev')
226
-
->json_has('/repoBlocks')
227
-
->json_has('/indexedRecords')
228
-
->json_has('/expectedBlobs')
229
-
->json_has('/importedBlobs');
230
-
231
-
my $account = $app->store->get_account_by_did($did);
232
-
my $original_did_doc = $account->{did_doc};
233
-
234
-
my %bad_endpoint_doc = %{$original_did_doc};
235
-
$bad_endpoint_doc{service} = [
236
-
map {
237
-
my %copy = %{$_};
238
-
$copy{serviceEndpoint} = 'https://elsewhere.example'
239
-
if ($copy{id} // q()) eq "$did#atproto_pds";
240
-
\%copy;
241
-
} @{ $original_did_doc->{service} || [] }
242
-
];
243
-
$app->store->update_account($did, did_doc => \%bad_endpoint_doc);
244
-
245
-
$t->get_ok('/xrpc/com.atproto.server.checkAccountStatus' => {
246
-
Authorization => "Bearer $access",
247
-
})->status_is(200)
248
-
->json_is('/validDid' => JSON::PP::false);
249
-
250
-
my %bad_key_doc = %{$original_did_doc};
251
-
$bad_key_doc{verificationMethod} = [
252
-
map {
253
-
my %copy = %{$_};
254
-
$copy{publicKeyMultibase} = 'zQmInvalidSigningKey'
255
-
if ($copy{id} // q()) eq "$did#atproto";
256
-
\%copy;
257
-
} @{ $original_did_doc->{verificationMethod} || [] }
258
-
];
259
-
$app->store->update_account($did, did_doc => \%bad_key_doc);
260
-
261
-
$t->get_ok('/xrpc/com.atproto.server.checkAccountStatus' => {
262
-
Authorization => "Bearer $access",
263
-
})->status_is(200)
264
-
->json_is('/validDid' => JSON::PP::false);
265
-
266
-
$app->store->update_account($did, did_doc => $original_did_doc);
267
-
268
-
$t->get_ok('/xrpc/com.atproto.server.checkAccountStatus' => {
269
-
Authorization => "Bearer $second_access",
270
-
})->status_is(200)
271
-
->json_is('/expectedBlobs' => 1)
272
-
->json_is('/importedBlobs' => 1);
273
-
274
-
$t->get_ok(Mojo::URL->new('/xrpc/com.atproto.admin.getAccountInfo')->query(
275
-
did => $did,
276
-
) => {
277
-
Authorization => $admin_auth,
278
-
})->status_is(200)
279
-
->json_is('/handle' => 'alice.example.test');
280
-
281
219
for my $cid ($blob_cid, $nested_blob_cid) {
282
220
$app->store->dbh->do(
283
221
q{DELETE FROM blob_owners WHERE cid = ?},