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 Test::More;
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::API::Util qw(flatten_params resolve_did_account resolve_repo);
20
21{
22 package ApiUtilTestStore;
23
24 sub new {
25 my ($class, %args) = @_;
26 return bless \%args, $class;
27 }
28
29 sub get_account_by_handle {
30 my ($self, $handle) = @_;
31 $self->{get_account_by_handle_calls}{$handle}++;
32 return $self->{accounts_by_handle}{$handle};
33 }
34
35 sub get_account_by_did {
36 my ($self, $did) = @_;
37 $self->{get_account_by_did_calls}{$did}++;
38 return $self->{accounts_by_did}{$did};
39 }
40
41 sub list_accounts {
42 my ($self) = @_;
43 $self->{list_accounts_calls}++;
44 return $self->{list_accounts} // [];
45 }
46}
47
48{
49 package ApiUtilTestContext;
50
51 sub new {
52 my ($class, $store, %args) = @_;
53 return bless { store => $store, %args }, $class;
54 }
55
56 sub store {
57 my ($self) = @_;
58 return $self->{store};
59 }
60
61 sub config_value {
62 my ($self, $key, $default) = @_;
63 return exists $self->{config}{$key} ? $self->{config}{$key} : $default;
64 }
65
66 sub stash {
67 my ($self, @args) = @_;
68 $self->{stash} //= {};
69 return $self->{stash}{$args[0]} if @args == 1;
70 if (@args == 2) {
71 $self->{stash}{$args[0]} = $args[1];
72 return $self;
73 }
74 die 'unsupported stash arity';
75 }
76}
77
78is_deeply(
79 [ flatten_params('a', ['b', 'c'], 'd') ],
80 ['a', 'b', 'c', 'd'],
81 'flatten_params flattens repeated query-style values',
82);
83
84my $store = ApiUtilTestStore->new(
85 accounts_by_handle => {
86 'alice.test' => { did => 'did:plc:alice', handle => 'alice.test' },
87 },
88 accounts_by_did => {
89 'did:plc:alice' => { did => 'did:plc:alice', handle => 'alice.test' },
90 },
91 list_accounts => [
92 { did => 'did:plc:alice', handle => 'alice.test' },
93 ],
94);
95
96my $c = ApiUtilTestContext->new($store, config => {
97 service_handle_domain => 'test',
98});
99
100is(resolve_repo($c, 'alice.test')->{did}, 'did:plc:alice', 'resolve_repo finds handles directly');
101is(resolve_repo($c, 'Alice.Test')->{did}, 'did:plc:alice', 'resolve_repo normalizes mixed-case handles');
102is(resolve_repo($c, 'did:plc:alice')->{handle}, 'alice.test', 'resolve_repo finds plain DIDs directly');
103is(resolve_repo($c, undef), undef, 'resolve_repo returns undef for empty input');
104is(resolve_repo($c, 'alice.test')->{did}, 'did:plc:alice', 'repeat resolve_repo handle lookup still resolves');
105is($store->{get_account_by_handle_calls}{'alice.test'}, 1, 'repeat resolve_repo handle lookup reuses the request cache');
106
107$store->{list_accounts_calls} = 0;
108my $encoded_c = ApiUtilTestContext->new($store, config => {
109 service_handle_domain => 'test',
110});
111is(resolve_did_account($encoded_c, 'did%3Aplc%3Aalice')->{handle}, 'alice.test', 'resolve_did_account accepts percent-encoded DIDs');
112is(resolve_did_account($encoded_c, 'did%3Aplc%3Aalice')->{handle}, 'alice.test', 'repeat resolve_did_account still resolves percent-encoded DIDs');
113is($store->{get_account_by_did_calls}{'did%3Aplc%3Aalice'}, 1, 'repeat percent-encoded DID lookup avoids another exact DID miss');
114is($store->{list_accounts_calls}, 1, 'repeat percent-encoded DID lookup reuses the request cache');
115
116done_testing;