perlsky is a Perl 5 implementation of an AT Protocol Personal Data Server.
1use v5.34;
2use warnings;
3
4use Config ();
5use FindBin qw($Bin);
6use File::Spec;
7use Test2::V0;
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::IPLD::Base32 qw(encode_base32 decode_base32);
20use ATProto::PDS::IPLD::Base58 qw(encode_base58btc decode_base58btc);
21use ATProto::PDS::IPLD::Base64 qw(encode_base64url decode_base64url);
22use ATProto::PDS::IPLD::CID qw(CODEC_DAG_CBOR CODEC_RAW);
23use ATProto::PDS::IPLD::DAGCBOR qw(encode_dag_cbor decode_dag_cbor cid_for_dag_cbor);
24use ATProto::PDS::IPLD::Bytes;
25use JSON::PP ();
26
27my $sample = "hello world\x00\xff";
28
29is(decode_base32(encode_base32($sample)), $sample, 'base32 round-trips bytes');
30is(decode_base58btc(encode_base58btc($sample)), $sample, 'base58btc round-trips bytes');
31is(decode_base64url(encode_base64url($sample)), $sample, 'base64url round-trips bytes');
32
33my $raw_cid = ATProto::PDS::IPLD::CID->from_data(CODEC_RAW, $sample);
34is("$raw_cid", $raw_cid->to_string, 'CID stringification uses multibase form');
35ok($raw_cid->equals(ATProto::PDS::IPLD::CID->parse($raw_cid->to_string)), 'CID base32 parse round-trips');
36ok($raw_cid->equals(ATProto::PDS::IPLD::CID->from_bytes($raw_cid->to_bytes)), 'CID byte parse round-trips');
37ok($raw_cid->equals(ATProto::PDS::IPLD::CID->parse($raw_cid->to_string('base58btc'))), 'CID base58btc parse round-trips');
38
39my $value = {
40 zed => 7,
41 alpha => [JSON::PP::true, JSON::PP::false, undef],
42 blob => ATProto::PDS::IPLD::Bytes->new("\x01\x02\x03"),
43 link => $raw_cid,
44 text => 'jalapeno',
45};
46
47my $encoded = encode_dag_cbor($value);
48my $decoded = decode_dag_cbor($encoded);
49
50is($decoded->{zed}, 7, 'decoded integer preserved');
51ok($decoded->{alpha}[0], 'decoded boolean true preserved');
52ok(!$decoded->{alpha}[1], 'decoded boolean false preserved');
53is($decoded->{alpha}[2], undef, 'decoded null preserved');
54is($decoded->{blob}->bytes, "\x01\x02\x03", 'decoded bytes preserved');
55ok($decoded->{link}->equals($raw_cid), 'decoded CID preserved');
56is($decoded->{text}, 'jalapeno', 'decoded text preserved');
57
58my $dag_cid = cid_for_dag_cbor({ hello => 'world' });
59is($dag_cid->codec, CODEC_DAG_CBOR, 'DAG-CBOR CID uses dag-cbor codec');
60ok($dag_cid->equals(ATProto::PDS::IPLD::CID->from_data(CODEC_DAG_CBOR, encode_dag_cbor({ hello => 'world' }))), 'CID matches encoded bytes');
61
62like(dies { decode_dag_cbor("\x9f\x01\x02\xff") }, qr/indefinite-length/, 'rejects indefinite-length CBOR');
63like(dies { decode_dag_cbor("\xfb\x7f\xf8\x00\x00\x00\x00\x00\x00") }, qr/floating point/, 'rejects floats');
64
65done_testing;