At

 view release on metacpan or  search on metacpan

lib/At.pm  view on Meta::CPAN

        method did() {
            $self->session->{did};
        }

        method session() {
            $session //= $self->get('com.atproto.server.getSession');
            $session;
        }
        ## Internals
        sub now                             { Time::Moment->now }
        sub _percent ( $limit, $remaining ) { $remaining && $limit ? ( ( $limit / $remaining ) * 100 ) : 0 }
        sub _plural( $count, $word )        { $count ? sprintf '%d %s%s', $count, $word, $count == 1 ? '' : 's' : () }

        sub _duration ($seconds) {
            $seconds || return '0 seconds';
            $seconds = abs $seconds;                                                                        # just in case
            my ( $time, @times ) = reverse grep {defined} _plural( int( $seconds / 31536000 ), 'year' ),    # assume 365 days and no leap seconds
                _plural( int( ( $seconds % 31536000 ) / 604800 ), 'week' ), _plural( int( ( $seconds % 604800 ) / 86400 ), 'day' ),
                _plural( int( ( $seconds % 86400 ) / 3600 ),      'hour' ), _plural( int( ( $seconds % 3600 ) / 60 ),      'minute' ),
                _plural( $seconds % 60,                           'second' );
            join ' and ', @times ? join( ', ', reverse @times ) : (), $time;

lib/At.pm  view on Meta::CPAN

        #
        method ratelimit_ ( $rate, $type, $meta //= () ) {    #~ https://docs.bsky.app/docs/advanced-guides/rate-limits
            defined $meta ? $ratelimits{$type}{$meta} = $rate : $ratelimits{$type} = $rate;
        }

        method _ratecheck( $type, $meta //= () ) {
            my $rate = defined $meta ? $ratelimits{$type}{$meta} : $ratelimits{$type};
            $rate->{reset} // return;
            return warnings::warnif( At => sprintf 'Exceeded %s rate limit. Try again in %s', $type, _duration( $rate->{reset} - time ) )
                if defined $rate->{reset} && $rate->{remaining} == 0 && $rate->{reset} > time;
            my $percent = _percent( $rate->{remaining}, $rate->{limit} );
            warnings::warnif(
                At => sprintf '%.2f%% of %s rate limit remaining (%d of %d). Slow down or try again in %s',
                $percent, $type, $rate->{remaining}, $rate->{limit}, _duration( $rate->{reset} - time )
            ) if $percent <= 5;
        }

        # Init
        {
            our %capture;

            sub namespace2package ($fqdn) {
                my $namespace = $fqdn =~ s[[#\.]][::]gr;
                'At::Lexicon::' . $namespace;
            }

lib/At/Protocol/DID.pm  view on Meta::CPAN

    }

    #~ Taken from https://github.com/bluesky-social/atproto/blob/main/packages/syntax/src/did.ts
    #~ Human-readable constraints:
    #~   - valid W3C DID (https://www.w3.org/TR/did-core/#did-syntax)
    #~      - entire URI is ASCII: [a-zA-Z0-9._:%-]
    #~      - always starts "did:" (lower-case)
    #~      - method name is one or more lower-case letters, followed by ":"
    #~      - remaining identifier can have any of the above chars, but can not end in ":"
    #~      - it seems that a bunch of ":" can be included, and don't need spaces between
    #~      - "%" is used only for "percent encoding" and must be followed by two hex characters (and thus can't end in "%")
    #~      - query ("?") and fragment ("#") stuff is defined for "DID URIs", but not as part of identifier itself
    #~      - "The current specification does not take a position on the maximum length of a DID"
    #~   - in current atproto, only allowing did:plc and did:web. But not *forcing* this at lexicon layer
    #~   - hard length limit of 8KBytes
    #~   - not going to validate "percent encoding" here
    sub ensureValidDid ($did) {

        # check that all chars are boring ASCII
        throw InvalidDidError('Disallowed characters in DID (ASCII letters, digits, and a couple other characters only)')
            unless $did =~ /^[a-zA-Z0-9._:%-]*$/;
        #
        my @parts = split ':', $did, -1;    # negative limit, ftw
        throw InvalidDidError('DID requires prefix, method, and method-specific content') if @parts < 3;
        #
        throw InvalidDidError('DID requires "did:" prefix') if $parts[0] ne 'did';

lib/At/Protocol/URI.pm  view on Meta::CPAN

    #~ Validation utils from https://github.com/bluesky-social/atproto/blob/main/packages/syntax/src/aturi_validation.ts
    #~  Human-readable constraints on ATURI:
    #~    - following regular URLs, a 8KByte hard total length limit
    #~    - follows ATURI docs on website
    #~       - all ASCII characters, no whitespace. non-ASCII could be URL-encoded
    #~       - starts "at://"
    #~       - "authority" is a valid DID or a valid handle
    #~       - optionally, follow "authority" with "/" and valid NSID as start of path
    #~       - optionally, if NSID given, follow that with "/" and rkey
    #~       - rkey path component can include URL-encoded ("percent encoded"), or:
    #~           ALPHA / DIGIT / "-" / "." / "_" / "~" / ":" / "@" / "!" / "$" / "&" / "'" / "(" / ")" / "*" / "+" / "," / ";" / "="
    #~           [a-zA-Z0-9._~:@!$&'\(\)*+,;=-]
    #~       - rkey must have at least one char
    #~       - regardless of path component, a fragment can follow  as "#" and then a JSON pointer (RFC-6901)
    sub ensureValidAtUri($uri) {
        my $fragmentPart;
        my @uriParts = split '#', $uri, -1;    # negative limit, ftw
        throw InvalidAtUriError('ATURI can have at most one "#", separating fragment out') if scalar @uriParts > 2;
        $fragmentPart = $uriParts[1];
        $uri          = $uriParts[0];