perlsky is a Perl 5 implementation of an AT Protocol Personal Data Server.
Proxy appview and chat XRPC through service auth
+546
-10
+2
README.md
+2
README.md
···
36
36
- `script/perlsky-admin create-invite` can mint invite codes locally on the server without needing an existing user session.
37
37
- The invite-only bootstrap flow is documented with copy-pasteable commands in `docs/DEPLOYMENT.md`.
38
38
- Browser clients such as `bsky.app` can talk to `perlsky` directly because XRPC and DID-document responses include CORS headers and answer OPTIONS preflight requests.
39
+
- Unknown `app.bsky.*` requests are proxied to `https://api.bsky.app` by default, and unknown `chat.bsky.*` requests are proxied to `https://api.bsky.chat` by default using per-account service-auth JWTs.
40
+
- Set `bsky_appview_url` / `bsky_appview_did` or `chat_service_url` / `chat_service_did` in your config if you want different upstream services.
39
41
40
42
Relay / crawler discovery:
41
43
+5
docs/DEPLOYMENT.md
+5
docs/DEPLOYMENT.md
···
63
63
"jwt_secret": "REPLACE_WITH_A_RANDOM_SECRET",
64
64
"admin_password": "REPLACE_WITH_A_RANDOM_SECRET",
65
65
"metrics_token": "REPLACE_WITH_A_RANDOM_SECRET",
66
+
"bsky_appview_url": "https://api.bsky.app",
67
+
"bsky_appview_did": "did:web:api.bsky.app",
68
+
"chat_service_url": "https://api.bsky.chat",
69
+
"chat_service_did": "did:web:api.bsky.chat",
66
70
"crawlers": ["https://bsky.network"],
67
71
"crawler_notify_interval": 1200,
68
72
"data_dir": "/var/lib/perlsky/data",
···
79
83
- `invite_code_required`: if true, `createAccount` requires a valid invite code
80
84
- `account_did_method`: set to `did:plc` if you want PLC-backed user DIDs
81
85
- `plc_rotation_private_key_hex`: required for `did:plc` account creation
86
+
- `bsky_appview_*` / `chat_service_*`: upstream AppView and chat services for unknown `app.bsky.*` and `chat.bsky.*` calls. The public Bluesky services are the normal defaults.
82
87
- `crawlers`: relay/crawler origins to notify after repo activity
83
88
84
89
## Launcher
+4
etc/perlsky.example.json
+4
etc/perlsky.example.json
···
9
9
"jwt_secret": "change-me",
10
10
"admin_password": "change-me-too",
11
11
"metrics_token": "change-me-metrics",
12
+
"bsky_appview_url": "https://api.bsky.app",
13
+
"bsky_appview_did": "did:web:api.bsky.app",
14
+
"chat_service_url": "https://api.bsky.chat",
15
+
"chat_service_did": "did:web:api.bsky.chat",
12
16
"crawlers": [],
13
17
"crawler_notify_interval": 1200,
14
18
"data_dir": "data/runtime",
+6
lib/ATProto/PDS.pm
+6
lib/ATProto/PDS.pm
···
20
20
use ATProto::PDS::LexiconRegistry;
21
21
use ATProto::PDS::Metrics;
22
22
use ATProto::PDS::Repo::Manager;
23
+
use ATProto::PDS::ServiceProxy;
23
24
use ATProto::PDS::Store::SQLite;
24
25
use ATProto::PDS::XRPC::Dispatcher;
25
26
use File::Spec;
···
109
110
state $manager = ATProto::PDS::Repo::Manager->new(
110
111
store => $c->store,
111
112
crawler_notifier => $c->crawler_notifier,
113
+
);
114
+
});
115
+
$self->helper(service_proxy => sub ($c) {
116
+
state $proxy = ATProto::PDS::ServiceProxy->new(
117
+
settings => $c->app->settings,
112
118
);
113
119
});
114
120
+10
-7
lib/ATProto/PDS/API/Server.pm
+10
-7
lib/ATProto/PDS/API/Server.pm
···
10
10
11
11
use ATProto::PDS::API::Helpers qw(find_account invite_code_view verify_account_password);
12
12
use ATProto::PDS::API::Util qw(iso8601 xrpc_error);
13
-
use ATProto::PDS::Auth::JWT qw(decode_jwt encode_jwt);
13
+
use ATProto::PDS::Auth::JWT qw(decode_jwt encode_jwt encode_service_jwt);
14
14
use ATProto::PDS::Auth::Password qw(hash_password random_hex);
15
15
use ATProto::PDS::Identity qw(account_did account_did_doc normalize_handle service_did);
16
16
use ATProto::PDS::Moderation qw(assert_login_allowed);
···
425
425
426
426
$registry->register('com.atproto.server.getServiceAuth', sub ($c, $endpoint) {
427
427
my (undef, $account) = require_auth($c, audience => 'access', allow_refresh => 1);
428
+
my $aud = $c->param('aud') // q();
429
+
xrpc_error(400, 'InvalidRequest', 'aud is required') unless length $aud;
428
430
my $requested_exp = $c->param('exp');
429
431
my $now = time;
430
432
my $exp = defined($requested_exp) ? int($requested_exp) : ($now + 60);
431
433
xrpc_error(400, 'BadExpiration', 'Requested expiration is out of bounds')
432
434
if $exp <= $now || $exp > ($now + 3600);
433
-
my $token = encode_jwt({
434
-
iss => service_did($c->app->settings),
435
-
sub => $account->{did},
436
-
aud => $c->param('aud'),
435
+
xrpc_error(500, 'SigningKeyUnavailable', 'Account signing key is unavailable')
436
+
unless defined($account->{private_key}) && length($account->{private_key});
437
+
my $token = encode_service_jwt({
438
+
iss => $account->{did},
439
+
iat => $now,
440
+
aud => $aud,
437
441
exp => $exp,
438
-
typ => 'service',
439
442
($c->param('lxm') ? (lxm => $c->param('lxm')) : ()),
440
-
}, $c->config_value('jwt_secret', 'perlsky-dev-secret'));
443
+
}, $account->{private_key});
441
444
return { token => $token };
442
445
});
443
446
+28
-1
lib/ATProto/PDS/Auth/JWT.pm
+28
-1
lib/ATProto/PDS/Auth/JWT.pm
···
9
9
use Digest::SHA qw(hmac_sha256);
10
10
use JSON::PP qw(decode_json encode_json);
11
11
use MIME::Base64 qw(decode_base64 encode_base64);
12
+
use ATProto::PDS::Auth::Password qw(random_hex);
13
+
use ATProto::PDS::Crypto::Secp256k1 qw(sign_compact_low_s);
12
14
13
-
our @EXPORT_OK = qw(decode_jwt encode_jwt);
15
+
our @EXPORT_OK = qw(decode_jwt encode_jwt encode_service_jwt);
14
16
15
17
sub encode_jwt ($claims, $secret, $header = undef) {
16
18
die 'claims must be a hashref' unless ref($claims) eq 'HASH';
···
63
65
header => $header,
64
66
claims => $claims,
65
67
};
68
+
}
69
+
70
+
sub encode_service_jwt ($claims, $private_key, $header = undef) {
71
+
die 'claims must be a hashref' unless ref($claims) eq 'HASH';
72
+
die 'private key is required' unless defined $private_key && length $private_key;
73
+
74
+
my %jwt_claims = %$claims;
75
+
my $now = time;
76
+
$jwt_claims{iat} //= $now;
77
+
$jwt_claims{exp} //= $jwt_claims{iat} + 60;
78
+
$jwt_claims{jti} //= random_hex(16);
79
+
delete @jwt_claims{grep { !defined $jwt_claims{$_} } keys %jwt_claims};
80
+
81
+
my $jwt_header = {
82
+
alg => 'ES256K',
83
+
typ => 'JWT',
84
+
%{ $header // {} },
85
+
};
86
+
87
+
my $header_b64 = _b64url_encode(encode_json($jwt_header));
88
+
my $claims_b64 = _b64url_encode(encode_json(\%jwt_claims));
89
+
my $signing_str = join('.', $header_b64, $claims_b64);
90
+
my $sig = _b64url_encode(sign_compact_low_s($private_key, $signing_str));
91
+
92
+
return join('.', $signing_str, $sig);
66
93
}
67
94
68
95
sub _b64url_encode ($bytes) {
+159
lib/ATProto/PDS/ServiceProxy.pm
+159
lib/ATProto/PDS/ServiceProxy.pm
···
1
+
package ATProto::PDS::ServiceProxy;
2
+
3
+
use v5.34;
4
+
use warnings;
5
+
6
+
use Mojo::Base -base, -signatures;
7
+
use Mojo::URL;
8
+
use Mojo::UserAgent;
9
+
10
+
use ATProto::PDS::API::Server qw(require_auth);
11
+
use ATProto::PDS::API::Util qw(xrpc_error);
12
+
use ATProto::PDS::Auth::JWT qw(encode_service_jwt);
13
+
14
+
has settings => sub { {} };
15
+
has ua => sub {
16
+
my $ua = Mojo::UserAgent->new(max_redirects => 0);
17
+
$ua->request_timeout(15);
18
+
$ua->inactivity_timeout(30);
19
+
return $ua;
20
+
};
21
+
22
+
sub proxy_xrpc_request ($self, $c, $nsid) {
23
+
my $target = $self->_target_for_request($c, $nsid) or return undef;
24
+
25
+
my $method = $c->req->method;
26
+
xrpc_error(400, 'InvalidRequest', 'XRPC proxy only supports GET, HEAD, and POST')
27
+
unless $method eq 'GET' || $method eq 'HEAD' || $method eq 'POST';
28
+
29
+
my $url = Mojo::URL->new($target->{url});
30
+
$url->path($c->req->url->path->to_string);
31
+
$url->query($c->req->url->query->clone);
32
+
33
+
my %headers = (
34
+
'Accept-Encoding' => 'identity',
35
+
);
36
+
for my $pair (
37
+
['Accept-Language', 'Accept-Language'],
38
+
['Atproto-Accept-Labelers', 'Atproto-Accept-Labelers'],
39
+
['X-Bsky-Topics', 'X-Bsky-Topics'],
40
+
) {
41
+
my ($source, $dest) = @$pair;
42
+
my $value = $c->req->headers->header($source);
43
+
$headers{$dest} = $value if defined $value && length $value;
44
+
}
45
+
46
+
if ($method eq 'POST') {
47
+
for my $name (qw(Content-Type Content-Encoding)) {
48
+
my $value = $c->req->headers->header($name);
49
+
$headers{$name} = $value if defined $value && length $value;
50
+
}
51
+
}
52
+
53
+
my $auth = $c->req->headers->authorization;
54
+
if (defined $auth && length $auth) {
55
+
my (undef, $account) = require_auth($c, audience => 'access', allow_refresh => 1);
56
+
xrpc_error(500, 'SigningKeyUnavailable', 'Account signing key is unavailable')
57
+
unless defined($account->{private_key}) && length($account->{private_key});
58
+
$headers{Authorization} = 'Bearer ' . encode_service_jwt(
59
+
{
60
+
iss => $account->{did},
61
+
aud => $target->{did},
62
+
lxm => $nsid,
63
+
},
64
+
$account->{private_key},
65
+
);
66
+
}
67
+
68
+
my $tx = $method eq 'POST'
69
+
? $self->ua->build_tx($method => $url => \%headers => ($c->req->body // q()))
70
+
: $self->ua->build_tx($method => $url => \%headers);
71
+
72
+
$tx = eval { $self->ua->start($tx) };
73
+
if (my $err = $@) {
74
+
my $message = "$err";
75
+
xrpc_error(502, 'UpstreamFailure', $message || 'Upstream service unreachable');
76
+
}
77
+
78
+
my $res = $tx->result;
79
+
if (my $err = $res->error) {
80
+
xrpc_error(502, 'UpstreamFailure', $err->{message} // 'Upstream service unreachable')
81
+
unless $res->code;
82
+
}
83
+
84
+
my $status = $res->code // 502;
85
+
my $headers_out = $c->res->headers;
86
+
for my $name (
87
+
qw(
88
+
Content-Type
89
+
Content-Language
90
+
Atproto-Repo-Rev
91
+
Atproto-Content-Labelers
92
+
Retry-After
93
+
WWW-Authenticate
94
+
DPoP-Nonce
95
+
)
96
+
) {
97
+
my $value = $res->headers->header($name);
98
+
$headers_out->header($name => $value) if defined $value && length $value;
99
+
}
100
+
101
+
if ($method eq 'HEAD') {
102
+
$c->res->code($status);
103
+
$c->rendered($status);
104
+
return $status;
105
+
}
106
+
107
+
$c->render(
108
+
status => $status,
109
+
data => $res->body,
110
+
);
111
+
return $status;
112
+
}
113
+
114
+
sub _target_for_request ($self, $c, $nsid) {
115
+
if (my $proxy_to = $c->req->headers->header('Atproto-Proxy')) {
116
+
return $self->_target_from_proxy_header($proxy_to);
117
+
}
118
+
119
+
return {
120
+
did => $self->_config('chat_service_did', 'did:web:api.bsky.chat'),
121
+
url => $self->_config('chat_service_url', 'https://api.bsky.chat'),
122
+
} if $nsid =~ /\Achat\.bsky\./;
123
+
124
+
return {
125
+
did => $self->_config('bsky_appview_did', 'did:web:api.bsky.app'),
126
+
url => $self->_config('bsky_appview_url', 'https://api.bsky.app'),
127
+
} if $nsid =~ /\Aapp\.bsky\./;
128
+
129
+
return undef;
130
+
}
131
+
132
+
sub _target_from_proxy_header ($self, $proxy_to) {
133
+
xrpc_error(400, 'InvalidRequest', 'Proxy header cannot contain spaces')
134
+
if $proxy_to =~ /\s/;
135
+
136
+
my ($did, $service_id) = $proxy_to =~ /\A([^#]+)#([^#]+)\z/;
137
+
xrpc_error(400, 'InvalidRequest', 'Invalid proxy header format')
138
+
unless defined $did && defined $service_id;
139
+
140
+
my $appview_did = $self->_config('bsky_appview_did', 'did:web:api.bsky.app');
141
+
return {
142
+
did => $appview_did,
143
+
url => $self->_config('bsky_appview_url', 'https://api.bsky.app'),
144
+
} if $did eq $appview_did && $service_id eq 'bsky_appview';
145
+
146
+
my $chat_did = $self->_config('chat_service_did', 'did:web:api.bsky.chat');
147
+
return {
148
+
did => $chat_did,
149
+
url => $self->_config('chat_service_url', 'https://api.bsky.chat'),
150
+
} if $did eq $chat_did && $service_id eq 'bsky_chat';
151
+
152
+
xrpc_error(400, 'InvalidRequest', "Unsupported proxy target $proxy_to");
153
+
}
154
+
155
+
sub _config ($self, $key, $default) {
156
+
return $self->settings->{$key} // $default;
157
+
}
158
+
159
+
1;
+22
-1
lib/ATProto/PDS/XRPC/Dispatcher.pm
+22
-1
lib/ATProto/PDS/XRPC/Dispatcher.pm
···
63
63
$self->routes->any('/xrpc/*nsid')->to(cb => sub ($c) {
64
64
my $started = time;
65
65
my $method = $c->req->method;
66
+
my $nsid = $c->stash('nsid') // q();
66
67
my $finish_metrics = sub ($status, $endpoint_type = 'unknown', $nsid = $c->stash('nsid') // 'unknown') {
67
68
my $labels = {
68
69
method => $method,
···
78
79
);
79
80
};
80
81
81
-
my $endpoint = $by_id{ $c->stash('nsid') // q() };
82
+
my $endpoint = $by_id{$nsid};
82
83
unless ($endpoint) {
84
+
my $proxied_status = eval { $c->service_proxy->proxy_xrpc_request($c, $nsid) };
85
+
if (my $err = $@) {
86
+
if (ref($err) eq 'HASH' && $err->{error}) {
87
+
$finish_metrics->($err->{status} // 400, 'proxy', $nsid);
88
+
return $c->render(
89
+
status => $err->{status} // 400,
90
+
json => {
91
+
error => $err->{error},
92
+
message => $err->{message} // $err->{error},
93
+
},
94
+
);
95
+
}
96
+
die $err;
97
+
}
98
+
99
+
if (defined $proxied_status) {
100
+
$finish_metrics->($proxied_status, 'proxy', $nsid);
101
+
return;
102
+
}
103
+
83
104
$finish_metrics->(404);
84
105
return $c->render(
85
106
status => 404,
+42
-1
t/auth-jwt.t
+42
-1
t/auth-jwt.t
···
5
5
use File::Spec;
6
6
use FindBin qw($Bin);
7
7
use Test2::V0;
8
+
use JSON::PP qw(decode_json);
9
+
use MIME::Base64 qw(decode_base64);
8
10
9
11
BEGIN {
10
12
require lib;
···
16
18
);
17
19
}
18
20
19
-
use ATProto::PDS::Auth::JWT qw(decode_jwt encode_jwt);
21
+
use Crypt::PK::ECC;
22
+
use ATProto::PDS::Auth::JWT qw(decode_jwt encode_jwt encode_service_jwt);
23
+
use ATProto::PDS::Crypto::Secp256k1 qw(generate_keypair);
20
24
21
25
my $token = encode_jwt(
22
26
{
···
45
49
'expiration is enforced',
46
50
);
47
51
52
+
my $keys = generate_keypair();
53
+
my $service = encode_service_jwt(
54
+
{
55
+
iss => 'did:plc:alice',
56
+
aud => 'did:web:api.bsky.app',
57
+
exp => 1_900_000_000,
58
+
iat => 1_800_000_000,
59
+
lxm => 'app.bsky.actor.getPreferences',
60
+
jti => 'test-jti',
61
+
},
62
+
$keys->{private_key},
63
+
);
64
+
my ($header_b64, $claims_b64, $sig_b64) = split /\./, $service, 3;
65
+
my $header = decode_json(_b64url_decode($header_b64));
66
+
my $claims = decode_json(_b64url_decode($claims_b64));
67
+
68
+
is($header->{alg}, 'ES256K', 'service tokens use ES256K');
69
+
is($claims->{iss}, 'did:plc:alice', 'service token issuer round-trips');
70
+
is($claims->{aud}, 'did:web:api.bsky.app', 'service token audience round-trips');
71
+
is($claims->{lxm}, 'app.bsky.actor.getPreferences', 'service token method round-trips');
72
+
73
+
my $pk = Crypt::PK::ECC->new;
74
+
$pk->import_key_raw($keys->{public_key}, 'secp256k1');
75
+
ok(
76
+
$pk->verify_message_rfc7518(_b64url_decode($sig_b64), "$header_b64.$claims_b64", 'SHA256'),
77
+
'service token signature verifies',
78
+
);
79
+
48
80
done_testing;
81
+
82
+
sub _b64url_decode {
83
+
my ($text) = @_;
84
+
my $b64 = $text;
85
+
$b64 =~ tr/-_/+\//;
86
+
my $pad = length($b64) % 4;
87
+
$b64 .= '=' x (4 - $pad) if $pad;
88
+
return decode_base64($b64);
89
+
}
+33
t/server-auth.t
+33
t/server-auth.t
···
5
5
use File::Path qw(remove_tree);
6
6
use File::Spec;
7
7
use FindBin qw($Bin);
8
+
use JSON::PP qw(decode_json);
9
+
use MIME::Base64 qw(decode_base64);
8
10
use Test::More;
9
11
10
12
BEGIN {
···
18
20
}
19
21
20
22
use Test::Mojo;
23
+
use Crypt::PK::ECC;
21
24
use ATProto::PDS;
22
25
23
26
my $root = File::Spec->rel2abs(File::Spec->catdir($Bin, '..'));
···
104
107
})->status_is(200)
105
108
->json_is('/did' => $did);
106
109
110
+
$t->get_ok('/xrpc/com.atproto.server.getServiceAuth?aud=did:web:api.bsky.app&lxm=app.bsky.actor.getPreferences' => {
111
+
Authorization => "Bearer $access",
112
+
})->status_is(200)
113
+
->json_has('/token');
114
+
115
+
my ($header_b64, $claims_b64, $sig_b64) = split /\./, $t->tx->res->json->{token}, 3;
116
+
my $header = decode_json(_b64url_decode($header_b64));
117
+
my $claims = decode_json(_b64url_decode($claims_b64));
118
+
is($header->{alg}, 'ES256K', 'service auth uses ES256K');
119
+
is($claims->{iss}, $did, 'service auth issuer is the account DID');
120
+
is($claims->{aud}, 'did:web:api.bsky.app', 'service auth audience matches request');
121
+
is($claims->{lxm}, 'app.bsky.actor.getPreferences', 'service auth binds the requested method');
122
+
123
+
my $account = $t->app->store->get_account_by_did($did);
124
+
my $pk = Crypt::PK::ECC->new;
125
+
$pk->import_key_raw($account->{public_key}, 'secp256k1');
126
+
ok(
127
+
$pk->verify_message_rfc7518(_b64url_decode($sig_b64), "$header_b64.$claims_b64", 'SHA256'),
128
+
'service auth signature verifies',
129
+
);
130
+
107
131
done_testing;
132
+
133
+
sub _b64url_decode {
134
+
my ($text) = @_;
135
+
my $copy = $text;
136
+
$copy =~ tr/-_/+\//;
137
+
my $pad = length($copy) % 4;
138
+
$copy .= '=' x (4 - $pad) if $pad;
139
+
return decode_base64($copy);
140
+
}
+235
t/service-proxy.t
+235
t/service-proxy.t
···
1
+
use v5.34;
2
+
use warnings;
3
+
4
+
use Config ();
5
+
use File::Path qw(remove_tree);
6
+
use File::Spec;
7
+
use FindBin qw($Bin);
8
+
use JSON::PP qw(decode_json);
9
+
use MIME::Base64 qw(decode_base64);
10
+
use Test::More;
11
+
use Time::HiRes qw(sleep);
12
+
13
+
BEGIN {
14
+
require lib;
15
+
my $root = File::Spec->rel2abs(File::Spec->catdir($Bin, '..'));
16
+
lib->import(
17
+
File::Spec->catdir($root, 'lib'),
18
+
File::Spec->catdir($root, 'local', 'lib', 'perl5'),
19
+
File::Spec->catdir($root, 'local', 'lib', 'perl5', $Config::Config{archname}),
20
+
);
21
+
}
22
+
23
+
use Crypt::PK::ECC;
24
+
use IO::Socket::INET;
25
+
use Mojo::Server::Daemon;
26
+
use Mojo::UserAgent;
27
+
use Mojolicious;
28
+
use Test::Mojo;
29
+
use ATProto::PDS;
30
+
31
+
my @mock_pids;
32
+
END {
33
+
my $status = $?;
34
+
kill 'TERM', @mock_pids if @mock_pids;
35
+
waitpid($_, 0) for @mock_pids;
36
+
$? = $status;
37
+
}
38
+
39
+
my $root = File::Spec->rel2abs(File::Spec->catdir($Bin, '..'));
40
+
my $tmp = File::Spec->catdir($root, 'data', 'tmp-tests', 'service-proxy');
41
+
remove_tree($tmp) if -d $tmp;
42
+
43
+
my $appview_app = Mojolicious->new;
44
+
$appview_app->routes->get('/ready')->to(cb => sub {
45
+
my ($c) = @_;
46
+
$c->render(text => 'ok');
47
+
});
48
+
$appview_app->routes->any('/xrpc/*nsid')->to(cb => sub {
49
+
my ($c) = @_;
50
+
my $nsid = $c->stash('nsid');
51
+
my %body = (
52
+
nsid => $nsid,
53
+
auth => $c->req->headers->authorization,
54
+
);
55
+
$body{country} = $c->param('countryCode') if defined $c->param('countryCode');
56
+
$body{region} = $c->param('regionCode') if defined $c->param('regionCode');
57
+
if ($nsid eq 'app.bsky.actor.getPreferences') {
58
+
$body{preferences} = [{
59
+
'$type' => 'app.bsky.actor.defs#savedFeedsPref',
60
+
pinned => [],
61
+
saved => [],
62
+
}];
63
+
}
64
+
$c->render(json => \%body);
65
+
});
66
+
67
+
my $chat_app = Mojolicious->new;
68
+
$chat_app->routes->get('/ready')->to(cb => sub {
69
+
my ($c) = @_;
70
+
$c->render(text => 'ok');
71
+
});
72
+
$chat_app->routes->any('/xrpc/*nsid')->to(cb => sub {
73
+
my ($c) = @_;
74
+
$c->render(json => {
75
+
nsid => $c->stash('nsid'),
76
+
auth => $c->req->headers->authorization,
77
+
logs => [],
78
+
});
79
+
});
80
+
81
+
my $appview_url = _start_mock_server($appview_app);
82
+
my $chat_url = _start_mock_server($chat_app);
83
+
84
+
my $app = ATProto::PDS->new(
85
+
project_root => $root,
86
+
settings => {
87
+
base_url => 'http://127.0.0.1:7755',
88
+
service_did_method => 'did:web',
89
+
service_handle_domain => 'localhost',
90
+
jwt_secret => 'proxy-secret',
91
+
data_dir => $tmp,
92
+
db_path => File::Spec->catfile($tmp, 'perlsky.sqlite'),
93
+
bsky_appview_url => $appview_url,
94
+
bsky_appview_did => 'did:web:appview.test',
95
+
chat_service_url => $chat_url,
96
+
chat_service_did => 'did:web:chat.test',
97
+
},
98
+
);
99
+
my $t = Test::Mojo->new($app);
100
+
101
+
$t->post_ok('/xrpc/com.atproto.server.createAccount' => json => {
102
+
handle => 'alice',
103
+
email => 'alice@example.com',
104
+
password => 'password123',
105
+
})->status_is(200)
106
+
->json_has('/accessJwt')
107
+
->json_has('/did');
108
+
109
+
my $created = $t->tx->res->json;
110
+
my $access = $created->{accessJwt};
111
+
my $did = $created->{did};
112
+
my $account = $app->store->get_account_by_did($did);
113
+
114
+
$t->get_ok('/xrpc/app.bsky.ageassurance.getState?countryCode=GB®ionCode=ENG')
115
+
->status_is(200)
116
+
->json_is('/nsid' => 'app.bsky.ageassurance.getState')
117
+
->json_is('/country' => 'GB')
118
+
->json_is('/region' => 'ENG');
119
+
120
+
ok(!defined($t->tx->res->json->{auth}), 'anonymous appview request does not forward auth');
121
+
122
+
$t->get_ok('/xrpc/app.bsky.actor.getPreferences' => {
123
+
Authorization => "Bearer $access",
124
+
})->status_is(200)
125
+
->json_is('/preferences/0/$type' => 'app.bsky.actor.defs#savedFeedsPref');
126
+
127
+
my $appview_auth = _decode_bearer($t->tx->res->json->{auth});
128
+
is($appview_auth->{header}{alg}, 'ES256K', 'appview proxy auth uses ES256K');
129
+
is($appview_auth->{claims}{iss}, $did, 'appview proxy auth is issued by the account DID');
130
+
is($appview_auth->{claims}{aud}, 'did:web:appview.test', 'appview proxy auth targets the appview DID');
131
+
is($appview_auth->{claims}{lxm}, 'app.bsky.actor.getPreferences', 'appview proxy auth binds the proxied method');
132
+
ok(_verify_es256k($account->{public_key}, $appview_auth->{signing_input}, $appview_auth->{signature}), 'appview proxy auth signature verifies');
133
+
134
+
$t->get_ok('/xrpc/chat.bsky.convo.getLog' => {
135
+
Authorization => "Bearer $access",
136
+
})->status_is(200)
137
+
->json_is('/logs' => [])
138
+
->json_is('/nsid' => 'chat.bsky.convo.getLog');
139
+
140
+
my $chat_auth = _decode_bearer($t->tx->res->json->{auth});
141
+
is($chat_auth->{claims}{aud}, 'did:web:chat.test', 'chat proxy auth targets the chat DID');
142
+
is($chat_auth->{claims}{lxm}, 'chat.bsky.convo.getLog', 'chat proxy auth binds the chat method');
143
+
ok(_verify_es256k($account->{public_key}, $chat_auth->{signing_input}, $chat_auth->{signature}), 'chat proxy auth signature verifies');
144
+
145
+
$t->get_ok('/xrpc/app.bsky.actor.getPreferences' => {
146
+
Authorization => "Bearer $access",
147
+
'Atproto-Proxy' => 'did:web:appview.test#bsky_appview',
148
+
})->status_is(200)
149
+
->json_is('/nsid' => 'app.bsky.actor.getPreferences');
150
+
151
+
$t->get_ok('/xrpc/example.unsupported.method')
152
+
->status_is(404)
153
+
->json_is('/error' => 'UnknownMethod');
154
+
155
+
done_testing;
156
+
157
+
sub _decode_bearer {
158
+
my ($header) = @_;
159
+
like($header // q(), qr/\ABearer\s+/, 'upstream request includes bearer auth');
160
+
my ($token) = $header =~ /\ABearer\s+(.+)\z/;
161
+
my ($header_b64, $claims_b64, $sig_b64) = split /\./, $token, 3;
162
+
return {
163
+
header => decode_json(_b64url_decode($header_b64)),
164
+
claims => decode_json(_b64url_decode($claims_b64)),
165
+
signature => _b64url_decode($sig_b64),
166
+
signing_input => "$header_b64.$claims_b64",
167
+
};
168
+
}
169
+
170
+
sub _b64url_decode {
171
+
my ($text) = @_;
172
+
my $copy = $text;
173
+
$copy =~ tr/-_/+\//;
174
+
my $pad = length($copy) % 4;
175
+
$copy .= '=' x (4 - $pad) if $pad;
176
+
return decode_base64($copy);
177
+
}
178
+
179
+
sub _verify_es256k {
180
+
my ($public_key, $message, $signature) = @_;
181
+
my $pk = Crypt::PK::ECC->new;
182
+
$pk->import_key_raw($public_key, 'secp256k1');
183
+
return $pk->verify_message_rfc7518($signature, $message, 'SHA256');
184
+
}
185
+
186
+
sub _start_mock_server {
187
+
my ($mock_app) = @_;
188
+
my $port = _find_free_port();
189
+
my $pid = fork();
190
+
die 'fork failed' unless defined $pid;
191
+
192
+
if ($pid == 0) {
193
+
my $daemon = Mojo::Server::Daemon->new(
194
+
app => $mock_app,
195
+
listen => ["http://127.0.0.1:$port"],
196
+
silent => 1,
197
+
);
198
+
$daemon->run;
199
+
exit 0;
200
+
}
201
+
202
+
push @mock_pids, $pid;
203
+
my $url = "http://127.0.0.1:$port";
204
+
_wait_for_ready($url);
205
+
return $url;
206
+
}
207
+
208
+
sub _wait_for_ready {
209
+
my ($base_url) = @_;
210
+
my $ua = Mojo::UserAgent->new(max_redirects => 0);
211
+
for (1 .. 100) {
212
+
my $ok = eval {
213
+
my $tx = $ua->get("$base_url/ready");
214
+
my $res = $tx->result;
215
+
return ($res->code // 0) == 200;
216
+
};
217
+
if ($ok) {
218
+
return 1;
219
+
}
220
+
sleep 0.05;
221
+
}
222
+
die "mock server did not become ready at $base_url";
223
+
}
224
+
225
+
sub _find_free_port {
226
+
my $sock = IO::Socket::INET->new(
227
+
LocalAddr => '127.0.0.1',
228
+
LocalPort => 0,
229
+
Proto => 'tcp',
230
+
Listen => 5,
231
+
) or die "unable to allocate port: $!";
232
+
my $port = $sock->sockport;
233
+
close $sock;
234
+
return $port;
235
+
}