At

 view release on metacpan or  search on metacpan

lib/At.pm  view on Meta::CPAN

        blob    => method( $namespace, $schema, $data ) {$data},
        integer => method( $namespace, $schema, $data ) { int $data },
        object  => method( $namespace, $schema, $data ) {
            for my ( $name, $subschema )( %{ $schema->{properties} } ) {
                $data->{$name} = $self->_coerce( $namespace, $subschema, $data->{$name} );
            }
            $data;
        },
        ref => method( $namespace, $schema, $data ) {
            my $target_namespace = $self->_resolve_namespace( $namespace, $schema->{ref} );
            my $lexicon          = $self->_locate_lexicon($target_namespace);
            return $data unless $lexicon;
            $self->_coerce( $target_namespace, $lexicon, $data );
        },
        union   => method( $namespace, $schema, $data ) {$data},
        unknown => method( $namespace, $schema, $data ) {$data},
        string  => method( $namespace, $schema, $data ) {
            $data // return ();
            if ( defined $schema->{format} ) {
                if    ( $schema->{format} eq 'uri' )    { return URI->new($data); }
                elsif ( $schema->{format} eq 'at-uri' ) { return At::Protocol::URI->new($data); }
                elsif ( $schema->{format} eq 'datetime' ) {
                    return $data =~ /\D/ ? Time::Moment->from_string($data) : Time::Moment->from_epoch($data);
                }
                elsif ( $schema->{format} eq 'did' ) {
                    require At::Protocol::DID;
                    return At::Protocol::DID->new($data);
                }
                elsif ( $schema->{format} eq 'handle' ) {
                    require At::Protocol::Handle;
                    try { return At::Protocol::Handle->new($data); }
                    catch ($e) { return $data; }
                }
            }
            $data;
        }
    );

    method _coerce ( $namespace, $schema, $data ) {
        $data // return ();
        return $coercions{ $schema->{type} }->( $self, $namespace, $schema, $data ) if defined $coercions{ $schema->{type} };
        return $data;
    }

    method _resolve_namespace ( $l, $r ) {
        return $r if $r =~ m[\.];    # Absolute (has dots)
        my $base = $l =~ s[#(.+)$][]r;
        return $base . '#' . $r;     # Relative to base of current FQDN
    }

    # Identity & Helpers
    method did()                   { $session ? $session->did . '' : undef; }
    method resolve_handle($handle) { $self->get( 'com.atproto.identity.resolveHandle' => { handle => $handle } ); }

    method resolve_did_to_handle ($did) {
        my $doc = $self->resolve_did($did);
        return $doc->{alsoKnownAs}[0] =~ s/^at:\/\///r if $doc && $doc->{alsoKnownAs};
        return;
    }

    method upload_blob ( $data, $mime_type ) {
        $self->post( 'com.atproto.repo.uploadBlob' => { content => $data, headers => { 'Content-Type' => $mime_type } } );
    }

    method create_record ( $collection, $record, $rkey = undef ) {
        $self->post( 'com.atproto.repo.createRecord' =>
                { repo => $self->did, collection => $collection, record => $record, defined $rkey ? ( rkey => $rkey ) : () } );
    }

    method delete_record ( $collection, $rkey ) {
        $self->post( 'com.atproto.repo.deleteRecord' => { repo => $self->did, collection => $collection, rkey => $rkey } );
    }

    method put_record ( $collection, $rkey, $record, $swapRecord = undef ) {
        $self->post(
            'com.atproto.repo.putRecord' => {
                repo       => $self->did,
                collection => $collection,
                rkey       => $rkey,
                record     => $record,
                defined $swapRecord ? ( swapRecord => $swapRecord ) : ()
            }
        );
    }

    method apply_writes ( $writes, $swapCommit = undef ) {
        $self->post(
            'com.atproto.repo.applyWrites' => { repo => $self->did, writes => $writes, defined $swapCommit ? ( swapCommit => $swapCommit ) : () } );
    }

    method resolve_did ($did) {
        if ( $did =~ /^did:plc:(.+)$/ ) {
            my ($content) = $http->get( 'https://plc.directory/' . $did );
            return $content;
        }
        elsif ( $did =~ /^did:web:(.+)$/ ) {
            my $domain = $1;
            $domain =~ s/:/\//g;
            my ($content) = $http->get("https://$domain/.well-known/did.json");
            return $content;
        }
        return;
    }

    method pds_for_did ($did) {
        my $doc = $self->resolve_did($did);
        return unless $doc && ref $doc eq 'HASH' && $doc->{service};
        for my $service ( @{ $doc->{service} } ) {
            return $service->{serviceEndpoint} if $service->{type} eq 'AtprotoPersonalDataServer';
        }
        return;
    }

    method peer_id_for_did ($did) {
        my $doc = $self->resolve_did($did);
        return unless $doc && ref $doc eq 'HASH' && $doc->{verificationMethod};

        # Look for the primary signing key (usually the first one)
        my $vm                = $doc->{verificationMethod}[0];
        my $pub_key_multibase = $vm->{publicKeyMultibase} // return;

        # publicKeyMultibase for secp256k1 in atproto usually starts with 'z' (base58btc)

lib/At.pm  view on Meta::CPAN


A pre-instantiated L<At::UserAgent> object. By default, this is auto-detected by checking for L<Mojo::UserAgent>,
falling back to L<HTTP::Tiny>.

=back

=head2 C<oauth_start( $handle, $client_id, $redirect_uri, [ $scope ] )>

Initiates the OAuth 2.0 Authorization Code flow. Returns the authorization URL.

=head2 C<oauth_callback( $code, $state )>

Exchanges the authorization code for tokens and completes the OAuth flow.

=head2 C<oauth_refresh()>

Uses the session's refresh token to obtain a new set of access and refresh tokens. Automatically handles DPoP nonces
and spec-compliant proof generation (omitting C<ath> during refresh).

=head2 C<login( $handle, $app_password )>

Performs legacy password-based authentication. B<Deprecated: Use OAuth instead.>

=head2 C<resume( $access_jwt, $refresh_jwt, [ $token_type, $dpop_key_jwk, $client_id, $handle, $pds ] )>

Resumes a previous session using stored tokens and metadata.

=head2 C<get( $method, [ \%params ] )>

Calls an XRPC query (GET). Returns the decoded JSON response.

=head2 C<post( $method, [ \%data ] )>

Calls an XRPC procedure (POST). Returns the decoded JSON response.

=head2 C<subscribe( $method, $callback )>

Connects to a WebSocket stream (Firehose).

=head2 C<firehose( $callback, [ $url ] )>

Returns a new L<At::Protocol::Firehose> client. C<$url> defaults to the Bluesky relay firehose.

=head2 C<resolve_handle( $handle )>

Resolves a handle to a DID.

=head2 C<resolve_did_to_handle( $did )>

Reverse resolution: resolves a DID to its primary handle.

=head2 C<atproto_proxy( [ $service_did ] )>

Gets or sets the C<atproto-proxy> header value on the underlying user agent. When set, requests will be sent to the
primary C<host> but include this header, signaling the PDS to proxy the request to the specified service.

Example for Bluesky Chat:

    $at->http->at_protocol_proxy("did:web:api.bsky.chat#bsky_chat");

=head2 C<upload_blob( $data, $mime_type )>

Uploads a raw binary blob to the PDS. Returns the blob's metadata (CID, etc).

=head2 C<create_record( $collection, $record, [ $rkey ] )>

Helper to create a new record in a specific collection. Automatically uses the authenticated user's DID.

=head2 C<delete_record( $collection, $rkey )>

Helper to delete a record from a specific collection.

=head2 C<put_record( $collection, $rkey, $record, [ $swapRecord ] )>

Helper to write a record (creating or updating it) at a specific rkey.

=head2 C<apply_writes( $writes, [ $swapCommit ] )>

Atomic multi-record update. C<$writes> should be an arrayref of create/update/delete operations.

=head2 C<collection_scope( $collection, [ $action ] )>

Helper to generate granular OAuth scopes (e.g., C<repo:app.bsky.feed.post?action=create>).

=head2 C<session()>

Returns the current L<At::Protocol::Session> object.

=head2 C<did()>

Returns the DID of the authenticated user.

=head2 C<peer_id_for_did( $did )>

Resolves an AT Protocol DID to a libp2p PeerID. This is used to discover the user's data on the P2P network.

=head2 C<get_repo_head( $did )>

Retrieves the current MST (Merkle Search Tree) root CID for a user's repository via the C<com.atproto.sync.getHead>
endpoint.

=head2 C<get_block( $cid_str, [ $target_peer_id ] )>

Retrieves a raw block by its CID. If an C<ipfs_node> was provided to the constructor, this method will:

=over

=item Check the local blockstore.

=item Attempt to fetch the block via Bitswap from the provided C<$target_peer_id>.

=item Fall back to the centralized PDS via HTTP if the block is not found in the P2P network.

=back

Returns a L<Future> that resolves to the block data.

=head1 Decentralized Data Synchronization

When an C<ipfs_node> is provided to the L<At> constructor, the library enables peer-to-peer data synchronization
compliant with the AT Protocol Sync specification (L<https://atproto.com/specs/sync>).



( run in 2.159 seconds using v1.01-cache-2.11-cpan-b16cb0d3907 )