perlsky is a Perl 5 implementation of an AT Protocol Personal Data Server.
1use v5.34;
2use warnings;
3
4use Config ();
5use File::Path qw(remove_tree);
6use File::Spec;
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 Test::Mojo;
21use ATProto::PDS;
22
23my $root = File::Spec->rel2abs(File::Spec->catdir($Bin, '..'));
24my $tmp = File::Spec->catdir($root, 'data', 'tmp-tests', 'external-handle-update');
25remove_tree($tmp) if -d $tmp;
26
27my $t = Test::Mojo->new(ATProto::PDS->new(
28 project_root => $root,
29 settings => {
30 base_url => 'http://127.0.0.1:7755',
31 service_did_method => 'did:web',
32 service_handle_domain => 'localhost',
33 jwt_secret => 'external-handle-secret',
34 data_dir => $tmp,
35 db_path => File::Spec->catfile($tmp, 'perlsky.sqlite'),
36 },
37));
38
39$t->post_ok('/xrpc/com.atproto.server.createAccount' => json => {
40 handle => 'alice',
41 email => 'alice@example.com',
42 password => 'password123',
43})->status_is(200)
44 ->json_is('/handle' => 'alice.localhost');
45
46my $session = $t->tx->res->json;
47my $did = $session->{did};
48my $access = $session->{accessJwt};
49
50$t->post_ok('/xrpc/com.atproto.server.createAccount' => json => {
51 handle => 'bob',
52 email => 'bob@example.com',
53 password => 'password123',
54})->status_is(200)
55 ->json_is('/handle' => 'bob.localhost');
56
57$t->post_ok('/xrpc/com.atproto.identity.updateHandle' => {
58 Authorization => "Bearer $access",
59} => json => {
60 handle => 'bob.localhost',
61})->status_is(400)
62 ->json_is('/error' => 'InvalidRequest')
63 ->json_is('/message' => 'Handle already taken: bob.localhost');
64
65{
66 no warnings 'redefine';
67 local *ATProto::PDS::Identity::_resolve_handle_dns = sub {
68 my ($handle) = @_;
69 return $did if $handle eq 'alice.external';
70 return 'did:web:127.0.0.1%3A7755:users:someone-else' if $handle eq 'bob.external';
71 return undef;
72 };
73 local *ATProto::PDS::Identity::_resolve_handle_well_known = sub {
74 my ($handle) = @_;
75 return undef;
76 };
77
78 $t->post_ok('/xrpc/com.atproto.identity.updateHandle' => {
79 Authorization => "Bearer $access",
80 } => json => {
81 handle => 'alice.external',
82 })->status_is(200)
83 ->content_is(q());
84
85 $t->get_ok('/xrpc/com.atproto.identity.resolveHandle?handle=alice.external')
86 ->status_is(200)
87 ->json_is('/did' => $did);
88
89 $t->post_ok('/xrpc/com.atproto.server.createSession' => json => {
90 identifier => 'alice.external',
91 password => 'password123',
92 })->status_is(200)
93 ->json_is('/did' => $did)
94 ->json_is('/handle' => 'alice.external');
95
96 $t->post_ok('/xrpc/com.atproto.identity.updateHandle' => {
97 Authorization => "Bearer $access",
98 } => json => {
99 handle => 'bob.external',
100 })->status_is(400)
101 ->json_is('/error' => 'InvalidRequest')
102 ->json_is('/message' => 'External handle did not resolve to DID');
103
104 $t->post_ok('/xrpc/com.atproto.identity.updateHandle' => {
105 Authorization => "Bearer $access",
106 } => json => {
107 handle => 'missing.external',
108 })->status_is(400)
109 ->json_is('/error' => 'InvalidRequest')
110 ->json_is('/message' => 'External handle did not resolve to DID');
111}
112
113done_testing;