perlsky is a Perl 5 implementation of an AT Protocol Personal Data Server.
Strengthen identity helper coverage
+43
+43
t/identity.t
+43
t/identity.t
···
21
21
did_to_path
22
22
is_valid_handle
23
23
normalize_handle
24
+
resolve_handle_to_did
24
25
service_did
25
26
service_host
26
27
);
···
34
35
ok(!is_valid_handle('alice', 'example.com'), 'bare handles do not validate');
35
36
ok(is_valid_handle('alice.example.com', 'example.com'), 'allowed domains are enforced');
36
37
is(normalize_handle('@Alice', 'example.com'), 'alice.example.com', 'handles are normalized');
38
+
39
+
{
40
+
no warnings 'redefine';
41
+
local *ATProto::PDS::Identity::_resolve_handle_dns = sub {
42
+
my ($handle) = @_;
43
+
return 'did:plc:dns-preferred' if $handle eq 'alice.example.com';
44
+
return undef;
45
+
};
46
+
local *ATProto::PDS::Identity::_resolve_handle_well_known = sub {
47
+
my ($handle) = @_;
48
+
return 'did:plc:well-known-fallback' if $handle eq 'alice.example.com';
49
+
return undef;
50
+
};
51
+
52
+
is(
53
+
resolve_handle_to_did({ base_url => 'https://pds.example.com' }, '@Alice.Example.com'),
54
+
'did:plc:dns-preferred',
55
+
'handle resolution normalizes input and prefers DNS over well-known',
56
+
);
57
+
}
58
+
59
+
{
60
+
no warnings 'redefine';
61
+
local *ATProto::PDS::Identity::_resolve_handle_dns = sub { return undef; };
62
+
local *ATProto::PDS::Identity::_resolve_handle_well_known = sub {
63
+
my ($handle) = @_;
64
+
return 'did:web:example.com:users:alice' if $handle eq 'alice.example.com';
65
+
return undef;
66
+
};
67
+
68
+
is(
69
+
resolve_handle_to_did({ base_url => 'https://pds.example.com' }, 'alice.example.com'),
70
+
'did:web:example.com:users:alice',
71
+
'handle resolution falls back to well-known when DNS has no answer',
72
+
);
73
+
}
74
+
75
+
is(
76
+
resolve_handle_to_did({ base_url => 'https://pds.example.com' }, 'not a handle'),
77
+
undef,
78
+
'handle resolution rejects invalid handles before any network lookup',
79
+
);
37
80
38
81
done_testing;