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 FindBin qw($Bin);
7use Test2::V0;
8
9BEGIN {
10 require lib;
11 my $root = File::Spec->rel2abs(File::Spec->catdir($Bin, '..'));
12 lib->import(
13 File::Spec->catdir($root, 'lib'),
14 File::Spec->catdir($root, 'local', 'lib', 'perl5'),
15 File::Spec->catdir($root, 'local', 'lib', 'perl5', $Config::Config{archname}),
16 );
17}
18
19use ATProto::PDS::Identity qw(
20 account_did
21 account_did_doc_valid_for_service
22 did_to_path
23 is_valid_handle
24 normalize_handle
25 resolve_handle_to_did
26 service_did
27 service_host
28);
29
30is(service_host('http://127.0.0.1:7755'), '127.0.0.1:7755', 'non-default ports are preserved');
31is(service_did('http://127.0.0.1:7755'), 'did:web:127.0.0.1%3A7755', 'service did encodes the port');
32is(account_did('https://pds.example.com', 'alice01'), 'did:web:pds.example.com:users:alice01', 'account did nests under service did');
33is(did_to_path('did:web:pds.example.com:users:alice01'), '/users/alice01/did.json', 'account did maps back to a did.json path');
34
35ok(is_valid_handle('alice.example.com'), 'handles validate');
36ok(!is_valid_handle('alice', 'example.com'), 'bare handles do not validate');
37ok(is_valid_handle('alice.example.com', 'example.com'), 'allowed domains are enforced');
38is(normalize_handle('@Alice', 'example.com'), 'alice.example.com', 'handles are normalized');
39
40{
41 no warnings 'redefine';
42 local *ATProto::PDS::Identity::_resolve_handle_dns = sub {
43 my ($handle) = @_;
44 return 'did:plc:dns-preferred' if $handle eq 'alice.example.com';
45 return undef;
46 };
47 local *ATProto::PDS::Identity::_resolve_handle_well_known = sub {
48 my ($handle) = @_;
49 return 'did:plc:well-known-fallback' if $handle eq 'alice.example.com';
50 return undef;
51 };
52
53 is(
54 resolve_handle_to_did({ base_url => 'https://pds.example.com' }, '@Alice.Example.com'),
55 'did:plc:dns-preferred',
56 'handle resolution normalizes input and prefers DNS over well-known',
57 );
58}
59
60{
61 no warnings 'redefine';
62 local *ATProto::PDS::Identity::_resolve_handle_dns = sub { return undef; };
63 local *ATProto::PDS::Identity::_resolve_handle_well_known = sub {
64 my ($handle) = @_;
65 return 'did:web:example.com:users:alice' if $handle eq 'alice.example.com';
66 return undef;
67 };
68
69 is(
70 resolve_handle_to_did({ base_url => 'https://pds.example.com' }, 'alice.example.com'),
71 'did:web:example.com:users:alice',
72 'handle resolution falls back to well-known when DNS has no answer',
73 );
74}
75
76is(
77 resolve_handle_to_did({ base_url => 'https://pds.example.com' }, 'not a handle'),
78 undef,
79 'handle resolution rejects invalid handles before any network lookup',
80);
81
82ok(
83 account_did_doc_valid_for_service(
84 { base_url => 'https://pds.example.com' },
85 {
86 did => 'did:web:pds.example.com:users:alice01',
87 public_key_multibase => 'zExampleMultibaseKey',
88 did_doc => {
89 id => 'did:web:pds.example.com:users:alice01',
90 service => [{
91 id => '#atproto_pds',
92 type => 'AtprotoPersonalDataServer',
93 serviceEndpoint => 'https://pds.example.com',
94 }],
95 verificationMethod => [{
96 id => '#atproto',
97 controller => 'did:web:pds.example.com:users:alice01',
98 publicKeyMultibase => 'zExampleMultibaseKey',
99 }],
100 assertionMethod => ['#atproto'],
101 },
102 },
103 ),
104 'service DID-doc validation accepts relative service and verification ids',
105);
106
107done_testing;