File Coverage

lib/At/Protocol/DID.pm

Criterion	Covered	Total	%
statement	34	48	70.8
branch	16	16	100.0
condition			n/a
subroutine	8	10	80.0
pod	3	3	100.0
total	61	77	79.2

package At::Protocol::DID 1.0 {
    use v5.42;
    no warnings qw[experimental::try];
    use feature 'try';
    use At::Error qw[register throw];
    use parent -norequire => 'Exporter';
    use overload
        '""' => sub ( $s, $u, $q ) {
        $$s;
        };
    our %EXPORT_TAGS = ( all => [ our @EXPORT_OK = qw[ensureValidDid ensureValidDidRegex] ] );

    sub new( $class, $did ) {
        try {
            ensureValidDid($did);
        }
        catch ($err) { return; }
        bless \$did, $class;
    }

    #~ 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';
        #
        throw InvalidDidError('DID method must be lower-case letters') if $parts[1] !~ /^[a-z]+$/;
        #
        throw InvalidDidError('DID can not end with ":" or "%"')       if $did =~ /[:%]$/;
        throw InvalidDidError('DID is too long (2048 characters max)') if length $did > 2 * 1024;
        1;
    }

    sub ensureValidDidRegex ($did) {

        #~ simple regex to enforce most constraints via just regex and length.
        #~ hand wrote this regex based on above constraints
        throw InvalidDidError(q[DID didn't validate via regex])        if $did !~ /^did:[a-z]+:[a-zA-Z0-9._:%-]*[a-zA-Z0-9._-]$/;
        throw InvalidDidError('DID is too long (2048 characters max)') if length $did > 2 * 1024;
        #
        1;
    }

    # fatal error
    register 'InvalidDidError', 1;
};
1;
__END__