view release on metacpan or  search on metacpan

lib/Net/Nostr/Git.pm  view on Meta::CPAN

    for my $tag (@{$event->tags}) {
        push @servers, $tag->[1] if $tag->[0] eq 'g';
    }
    return $class->new(
        event_type    => 'grasp_list',
        grasp_servers => \@servers,
    );
}

sub _percent_encode {
    my ($str) = @_;
    utf8::encode($str) if utf8::is_utf8($str);
    $str =~ s/([^A-Za-z0-9._~-])/sprintf('%%%02X', ord($1))/ge;
    return $str;
}

sub _percent_decode {
    my ($str) = @_;
    $str =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/ge;
    utf8::decode($str);
    return $str;
}

sub nostr_clone_url {
    my ($class, %args) = @_;

    if (defined $args{naddr}) {
        decode_naddr($args{naddr});
        return "nostr://$args{naddr}";
    }

    my $owner      = $args{owner}      // croak "nostr_clone_url requires 'naddr' or 'owner'";
    my $identifier = $args{identifier} // croak "nostr_clone_url requires 'identifier'";

    croak "owner must not be empty" unless length $owner;

    my $enc_id = _percent_encode($identifier);

    if (defined $args{relay_hint}) {
        my $relay = $args{relay_hint};
        $relay =~ s{\Awss://}{};
        my $enc_relay = _percent_encode($relay);
        return "nostr://$owner/$enc_relay/$enc_id";
    }

    return "nostr://$owner/$enc_id";
}

sub parse_nostr_clone_url {
    my ($class, $url) = @_;
    croak "nostr:// URL required" unless defined $url && $url =~ m{\Anostr://(.+)\z}i;
    my $rest = $1;

    # naddr form
    if ($rest =~ /\Anaddr1/) {
        my $data = decode_naddr($rest);
        return $data;
    }

    # owner/[relay-hint/]identifier form
    my @parts = split m{/}, $rest, -1;
    my $owner = $parts[0];
    croak "owner must not be empty" unless defined $owner && length $owner;
    croak "nostr:// clone URL requires an identifier" if @parts < 2;

    if (@parts == 2) {
        return {
            owner      => $owner,
            identifier => _percent_decode($parts[1]),
        };
    }

    my $relay_hint = _percent_decode($parts[1]);
    $relay_hint = "wss://$relay_hint" unless $relay_hint =~ m{://};

    return {
        owner      => $owner,
        relay_hint => $relay_hint,
        identifier => _percent_decode($parts[2]),
    };
}

sub validate {
    my ($class, $event) = @_;
    my $kind = $event->kind;

    croak "not a NIP-34 event kind: $kind" unless $NIP34_KINDS{$kind};

    if ($kind == 30617 || $kind == 30618) {
        my $has_d;
        for my $tag (@{$event->tags}) {
            $has_d = 1 if $tag->[0] eq 'd';
        }
        croak "repository event MUST have a 'd' tag" unless $has_d;
    }
    elsif ($kind == 1617) {
        _require_tag($event, 'a', 'patch');
    }
    elsif ($kind == 1618) {
        _require_tag($event, 'a', 'pull request');
        _require_tag($event, 'c', 'pull request');
        _require_tag($event, 'clone', 'pull request');
    }
    elsif ($kind == 1619) {
        _require_tag($event, 'a', 'pull request update');
        _require_tag($event, 'E', 'pull request update');
        _require_tag($event, 'P', 'pull request update');
        _require_tag($event, 'c', 'pull request update');
        _require_tag($event, 'clone', 'pull request update');
    }
    elsif ($kind == 1621) {
        _require_tag($event, 'a', 'issue');
    }
    elsif ($kind >= 1630 && $kind <= 1633) {
        my $has_root;
        for my $tag (@{$event->tags}) {
            if ($tag->[0] eq 'e' && defined $tag->[3] && $tag->[3] eq 'root') {
                $has_root = 1;
                last;
            }
        }