perlsky is a Perl 5 implementation of an AT Protocol Personal Data Server.
Resolve OAuth permission sets via lexicon authorities
+283
-11
+114
-11
lib/ATProto/PDS/Auth/OAuth.pm
+114
-11
lib/ATProto/PDS/Auth/OAuth.pm
···
28
28
);
29
29
use ATProto::PDS::Auth::Password qw(random_hex timing_safe_eq);
30
30
use ATProto::PDS::Constants qw(TOKEN_AUD_ACCESS TOKEN_AUD_REFRESH);
31
+
use ATProto::PDS::Identity qw(did_to_path);
31
32
use ATProto::PDS::Moderation qw(assert_login_allowed is_repo_takedown);
33
+
use ATProto::PDS::PLC qw(is_plc_did refresh_plc_did_doc);
34
+
use ATProto::PDS::Repo::CAR qw(read_car);
35
+
use ATProto::PDS::Repo::DagCbor qw(decode_dag_cbor);
32
36
use ATProto::PDS::Util::BaseX qw(base64url_decode base64url_encode);
33
37
34
38
our @EXPORT_OK = qw(
···
755
759
return $cache{$nsid} = $local->{defs}{main};
756
760
}
757
761
758
-
my $authority_handle = _nsid_authority_handle($nsid);
759
-
return $cache{$nsid} = undef unless defined $authority_handle && length $authority_handle;
762
+
my $authority_did = $self->_resolve_lexicon_authority_did($nsid);
763
+
return undef unless defined $authority_did && length $authority_did;
760
764
761
-
my $appview_url = $c->config_value('bsky_appview_url', 'https://api.bsky.app');
762
-
return $cache{$nsid} = undef unless defined $appview_url && length $appview_url;
765
+
my $did_doc = $self->_resolve_remote_did_doc($authority_did);
766
+
return undef unless ref($did_doc) eq 'HASH';
763
767
764
-
my $url = Mojo::URL->new($appview_url)->path('/xrpc/com.atproto.repo.getRecord')->query(
765
-
repo => $authority_handle,
768
+
my $service_url = _did_doc_atproto_service($did_doc);
769
+
return undef unless defined $service_url && length $service_url;
770
+
771
+
my $url = Mojo::URL->new($service_url)->path('/xrpc/com.atproto.sync.getRecord')->query(
772
+
did => $authority_did,
766
773
collection => 'com.atproto.lexicon.schema',
767
774
rkey => $nsid,
768
775
);
769
776
my $tx = eval { $self->ua->get($url => { 'Accept-Encoding' => 'identity' }) };
770
-
return $cache{$nsid} = undef if $@ || !$tx;
777
+
return undef if $@ || !$tx;
771
778
772
779
my $res = $tx->result;
773
-
return $cache{$nsid} = undef unless $res && $res->is_success;
780
+
return undef unless $res && $res->is_success;
781
+
my $lexicon = _permission_set_lexicon_from_car($res->body, $nsid);
782
+
return undef unless ref($lexicon) eq 'HASH';
783
+
return $cache{$nsid} = $lexicon->{defs}{main};
784
+
}
785
+
786
+
sub _resolve_lexicon_authority_did ($self, $nsid) {
787
+
my $authority = _nsid_authority_handle($nsid);
788
+
return undef unless defined $authority && length $authority;
789
+
790
+
state $resolver = do {
791
+
return undef unless eval { require Net::DNS::Resolver; 1 };
792
+
Net::DNS::Resolver->new;
793
+
};
794
+
return undef unless $resolver;
795
+
796
+
my $packet = eval { $resolver->search('_lexicon.' . $authority, 'TXT') };
797
+
return undef if $@ || !$packet;
798
+
799
+
for my $rr ($packet->answer) {
800
+
next unless ($rr->type // q()) eq 'TXT';
801
+
for my $txt ($rr->txtdata) {
802
+
next unless defined $txt && $txt =~ /\Adid=(did:[^\s]+)\z/i;
803
+
return $1;
804
+
}
805
+
}
806
+
807
+
return undef;
808
+
}
809
+
810
+
sub _resolve_remote_did_doc ($self, $did) {
811
+
if (is_plc_did($did)) {
812
+
my $did_doc = eval { refresh_plc_did_doc($self->settings, $did) };
813
+
return undef if $@;
814
+
return $did_doc;
815
+
}
816
+
817
+
return undef unless defined $did && $did =~ /\Adid:web:/i;
818
+
819
+
my ($host, $path) = _web_did_origin_and_path($did);
820
+
return undef unless defined $host && defined $path;
821
+
my $scheme = $host =~ /\A(?:localhost|127\.0\.0\.1|\[::1\])(?::\d+)?\z/i ? 'http' : 'https';
822
+
my $url = Mojo::URL->new("$scheme://$host");
823
+
$url->path($path);
824
+
825
+
my $tx = eval { $self->ua->get($url) };
826
+
return undef if $@ || !$tx;
827
+
my $res = eval { $tx->result };
828
+
return undef if $@ || !$res;
829
+
return undef unless ($res->code // 0) == 200;
774
830
my $json = $res->json;
775
-
my $value = ref($json) eq 'HASH' ? $json->{value} : undef;
776
-
return $cache{$nsid} = undef unless _is_permission_set_lexicon($value, $nsid);
777
-
return $cache{$nsid} = $value->{defs}{main};
831
+
return undef unless ref($json) eq 'HASH' && ($json->{id} // q()) eq $did;
832
+
return $json;
833
+
}
834
+
835
+
sub _did_doc_atproto_service ($did_doc) {
836
+
return undef unless ref($did_doc) eq 'HASH';
837
+
my $services = $did_doc->{service};
838
+
return undef unless ref($services) eq 'ARRAY';
839
+
840
+
for my $service (@$services) {
841
+
next unless ref($service) eq 'HASH';
842
+
next unless ($service->{type} // q()) eq 'AtprotoPersonalDataServer';
843
+
my $endpoint = $service->{serviceEndpoint};
844
+
return $endpoint if defined $endpoint && length $endpoint;
845
+
}
846
+
847
+
return undef;
848
+
}
849
+
850
+
sub _web_did_origin_and_path ($did) {
851
+
return unless defined $did && $did =~ s/\Adid:web://i;
852
+
my @parts = split /:/, $did;
853
+
return unless @parts;
854
+
855
+
my $host = shift @parts;
856
+
$host =~ s/%3a/:/ig;
857
+
if (@parts && $parts[0] =~ /\A\d+\z/ && $host !~ /:/) {
858
+
$host .= ':' . shift @parts;
859
+
}
860
+
861
+
my $path = @parts
862
+
? '/' . join('/', map { s/%3A/:/igr } @parts) . '/did.json'
863
+
: did_to_path('did:web:' . $did);
864
+
return ($host, $path);
865
+
}
866
+
867
+
sub _permission_set_lexicon_from_car ($bytes, $nsid) {
868
+
return undef unless defined $bytes && length $bytes;
869
+
870
+
my $car = eval { read_car($bytes) };
871
+
return undef if $@ || ref($car) ne 'HASH';
872
+
873
+
for my $block (@{ $car->{blocks} || [] }) {
874
+
next unless ref($block) eq 'HASH' && defined($block->{bytes});
875
+
my $value = eval { decode_dag_cbor($block->{bytes}) };
876
+
next if $@;
877
+
return $value if _is_permission_set_lexicon($value, $nsid);
878
+
}
879
+
880
+
return undef;
778
881
}
779
882
780
883
sub _is_permission_set_lexicon ($lexicon, $nsid) {
+169
t/oauth-lexicon-resolution.t
+169
t/oauth-lexicon-resolution.t
···
1
+
use v5.34;
2
+
use warnings;
3
+
use feature 'signatures';
4
+
no warnings 'experimental::signatures';
5
+
6
+
use Config ();
7
+
use File::Spec;
8
+
use FindBin qw($Bin);
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 ATProto::PDS::Auth::OAuth;
22
+
use ATProto::PDS::Repo::CAR qw(write_car);
23
+
use ATProto::PDS::Repo::CID;
24
+
use ATProto::PDS::Repo::DagCbor qw(encode_dag_cbor);
25
+
26
+
{
27
+
package OAuthLexiconResolutionTestUA;
28
+
29
+
sub new ($class, %args) {
30
+
return bless {
31
+
body => $args{body},
32
+
calls => [],
33
+
}, $class;
34
+
}
35
+
36
+
sub get ($self, $url, @rest) {
37
+
push @{ $self->{calls} }, $url->to_string;
38
+
return bless {
39
+
body => $self->{body},
40
+
}, 'OAuthLexiconResolutionTestTx';
41
+
}
42
+
43
+
sub calls ($self) {
44
+
return $self->{calls};
45
+
}
46
+
}
47
+
48
+
{
49
+
package OAuthLexiconResolutionTestTx;
50
+
51
+
sub result ($self) {
52
+
return bless {
53
+
body => $self->{body},
54
+
}, 'OAuthLexiconResolutionTestResult';
55
+
}
56
+
}
57
+
58
+
{
59
+
package OAuthLexiconResolutionTestResult;
60
+
61
+
sub is_success { return 1 }
62
+
sub body ($self) { return $self->{body} }
63
+
}
64
+
65
+
{
66
+
package OAuthLexiconResolutionTestContext;
67
+
68
+
sub new ($class) {
69
+
return bless {}, $class;
70
+
}
71
+
72
+
sub app ($self) {
73
+
return bless {}, 'OAuthLexiconResolutionTestApp';
74
+
}
75
+
}
76
+
77
+
{
78
+
package OAuthLexiconResolutionTestApp;
79
+
80
+
sub lexicons ($self) {
81
+
return bless {}, 'OAuthLexiconResolutionTestLexicons';
82
+
}
83
+
}
84
+
85
+
{
86
+
package OAuthLexiconResolutionTestLexicons;
87
+
88
+
sub get ($self, $nsid) {
89
+
return undef;
90
+
}
91
+
}
92
+
93
+
my $nsid = 'pub.leaflet.authFullPermissions';
94
+
my $lexicon = {
95
+
lexicon => 1,
96
+
id => $nsid,
97
+
defs => {
98
+
main => {
99
+
type => 'permission-set',
100
+
permissions => [{
101
+
type => 'permission',
102
+
resource => 'rpc',
103
+
inheritAud => 1,
104
+
lxm => ['pub.leaflet.reader.getSavedFeeds'],
105
+
}],
106
+
},
107
+
},
108
+
};
109
+
110
+
my $bytes = encode_dag_cbor($lexicon);
111
+
my $car = write_car(
112
+
undef,
113
+
[{
114
+
cid => ATProto::PDS::Repo::CID->for_dag_cbor($bytes),
115
+
bytes => $bytes,
116
+
}],
117
+
);
118
+
my $ua = OAuthLexiconResolutionTestUA->new(body => $car);
119
+
my $oauth = ATProto::PDS::Auth::OAuth->new(
120
+
settings => { jwt_secret => 'test-secret' },
121
+
ua => $ua,
122
+
);
123
+
124
+
{
125
+
no warnings 'redefine';
126
+
local *ATProto::PDS::Auth::OAuth::_resolve_lexicon_authority_did = sub ($self, $loaded_nsid) {
127
+
return 'did:plc:btxrwcaeyodrap5mnjw2fvmz' if $loaded_nsid eq $nsid;
128
+
return undef;
129
+
};
130
+
local *ATProto::PDS::Auth::OAuth::_resolve_remote_did_doc = sub ($self, $did) {
131
+
return {
132
+
id => $did,
133
+
service => [{
134
+
id => '#atproto_pds',
135
+
type => 'AtprotoPersonalDataServer',
136
+
serviceEndpoint => 'https://chanterelle.us-west.host.bsky.network',
137
+
}],
138
+
};
139
+
};
140
+
141
+
my $loaded = $oauth->_load_permission_set(OAuthLexiconResolutionTestContext->new, $nsid);
142
+
is(
143
+
$loaded->{type},
144
+
'permission-set',
145
+
'permission set is loaded from the authority PDS sync.getRecord response',
146
+
);
147
+
is_deeply(
148
+
$loaded->{permissions},
149
+
$lexicon->{defs}{main}{permissions},
150
+
'permission-set permissions are preserved',
151
+
);
152
+
is(
153
+
scalar(@{ $ua->calls }),
154
+
1,
155
+
'permission-set loader makes a single remote request',
156
+
);
157
+
like(
158
+
$ua->calls->[0],
159
+
qr{\Ahttps://chanterelle\.us-west\.host\.bsky\.network/xrpc/com\.atproto\.sync\.getRecord\?},
160
+
'loader fetches lexicons from the authority PDS sync.getRecord endpoint',
161
+
);
162
+
like(
163
+
$ua->calls->[0],
164
+
qr{(?:\?|&)did=did%3Aplc%3Abtxrwcaeyodrap5mnjw2fvmz(?:&|\z)},
165
+
'loader queries the authority DID directly instead of an appview repo handle',
166
+
);
167
+
}
168
+
169
+
done_testing;