Bluesky
view release on metacpan or search on metacpan
lib/Bluesky.pm view on Meta::CPAN
method getLog(%args) { $self->_at_for('chat.bsky.convo.getLog')->get( 'chat.bsky.convo.getLog' => \%args ) }
# Video services (https://atproto.com/guides/video-handling)
#
# Video processing lives on a sidecar service (video.bsky.app), not on the
# PDS. Each call is authenticated with a short-lived service token minted
# by the user's PDS via com.atproto.server.getServiceAuth, then sent as a
# plain "Bearer" token. The session's DPoP token is NOT used here, which
# is why posting video to the PDS returns 501 Method Not Implemented.
method _video_http() { state $http //= HTTP::Tiny->new; $http }
# did:web form of the user's PDS. Used as the audience for the token that
# lets the video service deposit the processed blob in our PDS.
method _pds_did() {
my $session = eval { $self->at->session };
my $pds = ( builtin::blessed $session && $session->can('pds') ? $session->pds : undef ) // $self->at->host;
$pds = $pds . '';
$pds =~ s{^https?://}{};
$pds =~ s{/.*$}{};
$pds =~ s{:}{%3A}g; # did:web encodes the port separator
'did:web:' . $pds;
}
# Mint a service token for the given audience/lexicon. Returns the token
# string, or an At::Error which callers should propagate.
method _service_token ( $aud, $lxm, $exp = undef ) {
my $res = $self->at->get( 'com.atproto.server.getServiceAuth' => { aud => $aud, lxm => $lxm, exp => ( $exp // ( time + 1800 ) ) } );
return $res if builtin::blessed $res;
return $res->{token} if ref $res eq 'HASH' && defined $res->{token};
At::Error->new( message => 'getServiceAuth did not return a token', fatal => 1 );
}
method _video_url ( $lexicon, %query ) {
my $url = "$video_service/xrpc/$lexicon";
my @pairs = map { "$_=" . URI::Escape::uri_escape( $query{$_} ) } grep { defined $query{$_} } sort keys %query;
@pairs ? "$url?" . join( '&', @pairs ) : $url;
}
method _video_error ( $res, $content ) {
my $msg = $res->{reason} // 'Unknown error';
if ( ref $content eq 'HASH' ) {
my $detail = $content->{message} // $content->{error};
$msg = $detail . ' (' . $msg . ')' if defined $detail && $detail ne $msg;
}
At::Error->new( message => $msg, fatal => 1 );
}
# The video service wraps job data in a "jobStatus" key; unwrap it when
# present, otherwise return the payload untouched.
method _unwrap_job ($content) {
return $content unless ref $content eq 'HASH';
$content->{jobStatus} // $content;
}
method getVideoUploadLimits () {
my $token = $self->_service_token( 'did:web:video.bsky.app', 'app.bsky.video.getUploadLimits' );
return $token if builtin::blessed $token;
my $res = $self->_video_http->get( $self->_video_url('app.bsky.video.getUploadLimits'),
{ headers => { Authorization => "Bearer $token", Accept => 'application/json' } } );
my $content = $res->{content};
$content = decode_json($content) if defined $content && !ref $content && ( $res->{headers}{'content-type'} // '' ) =~ m[json];
$res->{success} ? $self->_unwrap_job($content) : $self->_video_error( $res, $content );
}
method getVideoJobStatus ( $jobId, %opts ) {
my $token = $opts{token} // $self->_service_token( 'did:web:video.bsky.app', 'app.bsky.video.getJobStatus', $opts{exp} );
return $token if builtin::blessed $token;
my $res = $self->_video_http->get(
$self->_video_url( 'app.bsky.video.getJobStatus', jobId => $jobId ),
{ headers => { Authorization => "Bearer $token", Accept => 'application/json' } }
);
my $content = $res->{content};
$content = decode_json($content) if defined $content && !ref $content && ( $res->{headers}{'content-type'} // '' ) =~ m[json];
return $self->_video_error( $res, $content ) unless $res->{success};
$self->_unwrap_job($content);
}
method uploadVideoJob ( $bytes, $mime_type = 'video/mp4', %opts ) {
if ( builtin::blessed $bytes ) { $bytes = $bytes->slurp_raw }
elsif ( !ref $bytes && $bytes !~ /[\x00-\x1f]/ && -e $bytes ) {
$bytes = path($bytes)->slurp_raw;
}
$opts{did} //= $self->did;
my $base = $opts{host} // $video_service;
my $query = join( '&', map { "$_=" . URI::Escape::uri_escape( $opts{$_} ) } grep { defined $opts{$_} } qw[did name] );
my $url = "$base/xrpc/app.bsky.video.uploadVideo" . ( $query ? "?$query" : '' );
# uploadVideo writes into the PDS on our behalf, so the token audience
# is the PDS and the lexicon is uploadBlob, not uploadVideo.
my $token = $opts{token} // $self->_service_token( $opts{aud} // $self->_pds_did, 'com.atproto.repo.uploadBlob', $opts{exp} );
return $token if builtin::blessed $token;
my $res
= $self->_video_http->post( $url, { content => $bytes, headers => { Authorization => "Bearer $token", 'Content-Type' => $mime_type } } );
my $content = $res->{content};
$content = decode_json($content) if defined $content && !ref $content && ( $res->{headers}{'content-type'} // '' ) =~ m[json];
# 409 Conflict means the video was already processed; the body still
# carries a usable jobStatus (including the finished blob).
return $self->_video_error( $res, $content ) unless $res->{success} || $res->{status} == 409;
$self->_unwrap_job($content);
}
# Drafts (private post drafts via stash)
method getDrafts(%args) {
my $res = $self->_at_for('app.bsky.draft.getDrafts')->get( 'app.bsky.draft.getDrafts' => \%args );
$res ? $res->{drafts} // () : $res;
}
method createDraft($draft) {
$self->_at_for('app.bsky.draft.createDraft')->post( 'app.bsky.draft.createDraft' => { draft => $draft } );
}
method updateDraft($draft) {
$self->_at_for('app.bsky.draft.updateDraft')->post( 'app.bsky.draft.updateDraft' => { draft => $draft } );
}
method deleteDraft($id) {
$self->_at_for('app.bsky.draft.deleteDraft')->post( 'app.bsky.draft.deleteDraft' => { id => $id } );
}
# Contacts (secure contact-import matching)
method getContactMatches(%args) {
my $res = $self->_at_for('app.bsky.contact.getMatches')->get( 'app.bsky.contact.getMatches' => \%args );
$res ? $res->{matches} // () : $res;
}
method getContactSyncStatus() {
my $res = $self->_at_for('app.bsky.contact.getSyncStatus')->get('app.bsky.contact.getSyncStatus');
$res ? $res->{syncStatus} // () : $res;
}
method importContacts(%args) {
my $res = $self->_at_for('app.bsky.contact.importContacts')->post( 'app.bsky.contact.importContacts' => \%args );
$res ? $res->{matchesAndContactIndexes} // () : $res;
}
method dismissContactMatch($subject) {
$self->_at_for('app.bsky.contact.dismissMatch')->post( 'app.bsky.contact.dismissMatch' => { subject => $subject } );
}
method removeContactData() {
$self->_at_for('app.bsky.contact.removeData')->post('app.bsky.contact.removeData');
}
method startPhoneVerification($phone) {
$self->_at_for('app.bsky.contact.startPhoneVerification')->post( 'app.bsky.contact.startPhoneVerification' => { phone => $phone } );
}
method verifyPhone( $phone, $code ) {
my $res = $self->_at_for('app.bsky.contact.verifyPhone')->post( 'app.bsky.contact.verifyPhone' => { phone => $phone, code => $code } );
$res ? $res->{token} // () : $res;
}
# Age assurance
method beginAgeAssurance(%args) {
lib/Bluesky.pm view on Meta::CPAN
$res || return;
my $root = my $parent = $res;
if ( $parent->{value}{reply} ) {
$root = $self->at->get( 'com.atproto.repo.getRecord', $self->parse_uri( $parent->{value}{reply}{root}{uri} ) );
$res ||= $parent; # escape hatch
}
{ root => { uri => $root->{uri}, cid => $root->{cid} }, parent => { uri => $parent->{uri}, cid => $parent->{cid} } };
}
method uploadFile( $bytes, $mime_type //= undef ) {
if ( builtin::blessed $bytes ) { $bytes = $bytes->slurp_raw }
elsif ( !ref $bytes && $bytes !~ /[\x00-\x1f]/ && -e $bytes ) {
$bytes = path($bytes)->slurp_raw;
}
# TODO: a non-naive implementation would strip EXIF metadata from JPEG files here by default
my $determined_mime
= defined $mime_type ? $mime_type :
( $bytes =~ /^GIF89a/ ? 'image/gif' :
$bytes =~ /^.{2}JFIF/ ? 'image/jpeg' :
$bytes =~ /^.{4}PNG\r\n\x1a\n/ ? 'image/png' :
$bytes =~ /^.{8}BM/ ? 'image/bmp' :
$bytes =~ /^.{4}(II|MM)\x42\x4D/ ? 'image/tiff' :
$bytes =~ /^.{4}8BPS/ ? 'image/psd' :
$bytes =~ /^data:image\/svg\+xml;/ ? 'image/svg+xml' :
$bytes =~ /^.{4}ftypqt / ? 'video/quicktime' :
$bytes =~ /^.{4}ftyp(isom|mp4[12]?|MSNV|M4[v|a]|f4v)/i ? 'video/mp4' :
'application/octet-stream' );
my $at_http = $self->at->http;
my $url = sprintf( '%s/xrpc/%s', $self->at->host, 'com.atproto.repo.uploadBlob' );
my %headers = ( 'Content-Type' => $determined_mime );
if ( $at_http && $at_http->can('auth') && $at_http->auth ) {
$headers{'Authorization'} = $at_http->auth;
}
if ( $at_http && $at_http->can('token_type') && $at_http->token_type eq 'DPoP' && $at_http->can('_generate_dpop_proof') ) {
$headers{DPoP} = $at_http->_generate_dpop_proof( $url, 'POST' );
}
state $http //= HTTP::Tiny->new;
my $res = $http->post( $url, { content => $bytes, headers => \%headers } );
my $content = $res->{content};
# Retry on DPoP nonce issues
if ( !$res->{success} ) {
my $body = $content;
if ( $body && !ref $body && ( $res->{status} == 401 || $res->{status} == 400 ) ) {
if ( $body =~ /use_dpop_nonce|dpop_nonce|required nonce|nonce in dpop|DPoP.*nonce/i && $at_http && $at_http->can('dpop_nonce') ) {
my $nonce;
foreach my $k ( keys %{ $res->{headers} } ) {
if ( lc($k) eq 'dpop-nonce' ) { $nonce = $res->{headers}{$k}; last; }
}
$at_http->dpop_nonce($nonce) if defined $nonce && $nonce ne '';
if ( $at_http && $at_http->can('_generate_dpop_proof') ) {
$headers{DPoP} = $at_http->_generate_dpop_proof( $url, 'POST' );
}
$res = $http->post( $url, { content => $bytes, headers => \%headers } );
$content = $res->{content};
}
}
}
if ( $res->{success} ) {
$content = decode_json($content) if $content && ( $res->{headers}{'content-type'} // '' ) =~ m[json];
return $content->{blob};
}
my $msg = $res->{reason} // 'Unknown error';
if ( $content && ( $res->{headers}{'content-type'} // '' ) =~ m[json] ) {
my $json = decode_json($content);
$msg .= ': ' . $json->{message} if $json->{message};
}
return At::Error->new( message => $msg, fatal => 1 );
}
# Upload a single image (path, bytes, handle, or Path::Tiny object),
# enforcing the 1 MB legacy image guard, and return its blob. Shared by
# the images and gallery embeds.
method _upload_image ( $img, $mime = undef ) {
if ( builtin::blessed $img && $img->can('slurp_raw') ) {
my $sz = $img->can('size') ? $img->size : length( $img->slurp_raw );
At::Error->new( message => 'image file size too large. 1000000 bytes maximum, got: ' . $sz )->throw if $sz > 1000000;
$img = $img->slurp_raw;
}
elsif ( !ref $img && $img !~ /[\x00-\x1f]/ && -e $img ) {
my $p = path($img);
my $sz = $p->size;
At::Error->new( message => 'image file size too large. 1000000 bytes maximum, got: ' . $sz )->throw if $sz > 1000000;
$img = $p->slurp_raw;
}
else {
my $sz = length $img;
At::Error->new( message => 'image file size too large. 1000000 bytes maximum, got: ' . $sz )->throw if $sz > 1000000;
}
my $blob = $self->uploadFile( $img, $mime );
builtin::blessed($blob) && $blob->isa('At::Error') ? $blob->throw : ();
$blob || At::Error->new( message => 'upload failed', fatal => 1 )->throw;
$blob;
}
# app.bsky.embed.images - up to 4 images, each { image, alt, [aspectRatio] }
method uploadImages(@images) {
my @ret;
for my $img (@images) {
my ( $alt, $mime, $aspectRatio ) = ( '', undef, undef );
if ( ( builtin::reftype($img) // '' ) eq 'HASH' ) {
$alt = $img->{alt} // '';
$mime = $img->{mime} // ();
$aspectRatio = $img->{aspectRatio};
$img = $img->{image};
}
my $blob = $self->_upload_image( $img, $mime );
push @ret, { alt => $alt, image => $blob, ( defined $aspectRatio ? ( aspectRatio => $aspectRatio ) : () ), };
}
{ '$type' => 'app.bsky.embed.images', images => \@ret };
}
# app.bsky.embed.gallery - up to 20 media items (soft limit 10 in clients),
# each item being an app.bsky.embed.gallery#image { image, alt, [aspectRatio] }
method uploadGallery(@items) {
my @ret;
for my $item (@items) {
my ( $alt, $mime, $aspectRatio ) = ( '', undef, undef );
if ( ( builtin::reftype($item) // '' ) eq 'HASH' ) {
$alt = $item->{alt} // '';
$mime = $item->{mime} // ();
$aspectRatio = $item->{aspectRatio};
$item = $item->{image};
}
lib/Bluesky.pm view on Meta::CPAN
}
}
}
{ '$type' => 'app.bsky.embed.video',
video => $blob,
( @captions ? ( captions => \@captions ) : () ), ( defined $opts{alt} ? ( alt => $opts{alt} ) : () ),
( defined $opts{aspectRatio} ? ( aspectRatio => $opts{aspectRatio} ) : () ),
( defined $opts{presentation} ? ( presentation => $opts{presentation} ) : () ),
};
}
method uploadVideo($vid) {
my ( $alt, $mime, $aspectRatio, $presentation, $captions );
if ( ( builtin::reftype($vid) // '' ) eq 'HASH' ) {
$alt = $vid->{alt};
$mime = $vid->{mime} // ();
$aspectRatio = $vid->{aspectRatio};
$presentation = $vid->{presentation};
$captions = $vid->{captions};
$vid = $vid->{video};
}
if ( builtin::blessed $vid && $vid->can('slurp_raw') ) {
my $szv = $vid->can('size') ? $vid->size : length( $vid->slurp_raw );
At::Error->new( message => 'video file size too large. 50000000 bytes maximum, got: ' . $szv )->throw if $szv > 50000000;
$vid = $vid->slurp_raw;
}
elsif ( !ref $vid && $vid !~ /[\x00-\x1f]/ && -e $vid ) {
my $pv = path($vid);
At::Error->new( message => 'video file size too large. 50000000 bytes maximum, got: ' . $pv->size )->throw if $pv->size > 50000000;
$vid = $pv->slurp_raw;
}
else {
At::Error->new( message => 'video file size too large. 50000000 bytes maximum, got: ' . length $vid )->throw if length $vid > 50000000;
}
my $blob = $self->uploadFile( $vid, $mime );
builtin::blessed($blob) && $blob->isa('At::Error') ? $blob->throw : ();
$blob || At::Error->new( message => 'upload failed', fatal => 1 )->throw;
return $self->videoEmbed( $blob, alt => $alt, aspectRatio => $aspectRatio, presentation => $presentation, captions => $captions );
}
method getEmbedRef($uri) {
my $res = $self->at->get( 'com.atproto.repo.getRecord', $self->parse_uri($uri) );
$res || return;
{ '$type' => 'app.bsky.embed.record', record => { uri => $res->{uri}, cid => $res->{cid} } };
}
method fetch_embed_url_card($url) {
my %card = ( uri => $url, title => '', description => '' );
state $http //= HTTP::Tiny->new;
my $res = $http->get($url);
if ( $res->{success} ) {
( $card{title} ) = $res->{content} =~ m[<title>(.*?)</title>.*</head>]is;
( $card{description} ) = ( $res->{content} =~ m[<meta name="description" content="(.*?)".+</meta>.*</head>]is ) // '';
my ($image) = $res->{content} =~ m[<img.*?src="([^"]*)"[^>]*>(?:</img>)?]isp;
if ( defined $image ) {
if ( $image =~ /^data:/ ) {
$card{thumb} = $self->uploadFile($image);
}
else {
$res = $http->get( URI->new_abs( $image, $url ) );
$card{thumb} = $res->{success} ? $self->uploadFile( $res->{content}, $res->{headers}{'content-type'} ) : ();
}
}
}
{ '$type' => 'app.bsky.embed.external', external => \%card };
}
};
#
1;
( run in 0.689 second using v1.01-cache-2.11-cpan-99fa8243a42 )