package HTTP::API::Client::Auth;
use strict; use warnings; use Exporter 'import'; use MIME::Base64 qw(encode_base64);
our @EXPORT_OK = qw(bearer_auth basic_auth api_key_auth);
sub bearer_auth { my ($token)=@_; die "bearer token must be a non-empty scalar\n" if !defined($token)||ref($token)||$token eq ''; return sub { my($ctx)=@_; _set_header_if_absent($ctx->{headers},'Authorization',"Bearer $token"); }; }
sub basic_auth { my($username,$password)=@_; die "basic auth username is required\n" if !defined($username)||ref($username); die "basic auth password is required\n" if !defined($password)||ref($password); my $credentials=encode_base64("$username:$password",''); return sub { my($ctx)=@_; _set_header_if_absent($ctx->{headers},'Authorization',"Basic $credentials"); }; }
sub api_key_auth { my(%args)=@_; my $in=delete($args{in})//'header'; my $name=delete $args{name}; my $value=delete $args{value}; die "unknown api_key auth option: $_\n" for sort keys %args; die "api_key in must be header or query\n" if $in ne 'header' && $in ne 'query'; die "api_key name must be a non-empty scalar\n" if !defined($name)||ref($name)||$name eq ''; die "api_key value must be a scalar\n" if !defined($value)||ref($value); if($in eq 'header'){ return sub { my($ctx)=@_; _set_header_if_absent($ctx->{headers},$name,"$value"); }; } return sub { my($ctx)=@_; my $url=$ctx->{url}; return if $url =~ /(?:[?&])\Q$name\E=/; my $sep=index($url,'?')>=0?'&':'?'; $ctx->{url}=$url.$sep._uri_escape($name).'='._uri_escape($value); }; }
sub _set_header_if_absent { my($headers,$name,$value)=@_; my $wanted=lc $name; return if grep { lc($_) eq $wanted } keys %$headers; $headers->{$name}=$value; }
sub _uri_escape { my($value)=@_; my $bytes="$value"; utf8::encode($bytes) if utf8::is_utf8($bytes); $bytes =~ s/([^A-Za-z0-9\-._~])/sprintf('%%%02X', ord($1))/ge; return $bytes; }
1;
