view release on metacpan or  search on metacpan

t/01-s3-lite.t  view on Meta::CPAN

  return 0 if $@ || !$res;

  # Verify it's actually LocalStack by checking the response body
  return 0 if $res->{status} != 200;
  my $status = JSON::PP->new->decode( $res->{content} );

  return $status->{services}{s3} =~ /^(?:available|running)$/xsm;
}

sub new_s3 {
  return Amazon::S3::Lite->new(
    { region                => 'us-east-1',
      aws_access_key_id     => 'test',
      aws_secret_access_key => 'test',
      @_,
    }
  );
}

sub new_localstack_s3 {
  return new_s3(
    host   => 'localhost:4566',
    secure => 0,
  );
}

# Returns a mock _request sub that captures calls and returns a canned response
sub mock_request {
  my (%args)   = @_;
  my $status   = $args{status}  // 200;
  my $content  = $args{content} // '';
  my $headers  = $args{headers} // {};
  my $captured = $args{capture};

  return sub {
    my ( $self, $method, $url, $req_headers, $body, $extra, $region ) = @_;
    if ($captured) {
      $$captured = {
        method  => $method,
        url     => $url,
        headers => $req_headers,
        body    => $body,
        region  => $region,
      };
    }
    return {
      status  => $status,
      reason  => 'OK',
      headers => $headers,
      content => $content,
    };
  };
}

########################################################################
# Unit tests — no network required
########################################################################

subtest 'constructor' => sub {

  # no credentials — stub _init_credentials so the test is immune to whether
  # Amazon::Credentials is installed or finds real creds (e.g. on an EC2 instance)
  {
    local $ENV{AWS_ACCESS_KEY_ID}     = undef;
    local $ENV{AWS_SECRET_ACCESS_KEY} = undef;
    no warnings 'redefine';
    local *Amazon::S3::Lite::_init_credentials = sub {
      my ( $self, $args ) = @_;
      Carp::croak 'No AWS credentials found.'
        if !$args->{credentials}
        && !$args->{aws_access_key_id}
        && !$ENV{AWS_ACCESS_KEY_ID};
    };
    eval { Amazon::S3::Lite->new( { region => 'us-east-1' } ) };
    like $@, qr/No AWS credentials/, 'croaks without credentials';
  }

  # explicit credentials
  my $s3 = new_s3();
  isa_ok $s3, 'Amazon::S3::Lite';
  is $s3->region, 'us-east-1',        'region set';
  is $s3->host,   's3.amazonaws.com', 'default host';

  # env credentials
  {
    local $ENV{AWS_ACCESS_KEY_ID}     = 'envkey';
    local $ENV{AWS_SECRET_ACCESS_KEY} = 'envsecret';
    local $ENV{AWS_SESSION_TOKEN}     = 'envtoken';
    my $s3e = Amazon::S3::Lite->new( { region => 'us-east-1' } );
    is $s3e->credentials->aws_access_key_id, 'envkey',   'env key';
    is $s3e->credentials->token,             'envtoken', 'env token';
  }

  # duck-typed credentials object
  {

    package MyCreds;
    sub new                   { bless {}, shift }
    sub aws_access_key_id     {'duckkey'}
    sub aws_secret_access_key {'ducksecret'}
    sub token                 {undef}

    package main;
    my $s3d = Amazon::S3::Lite->new(
      { region      => 'us-east-1',
        credentials => MyCreds->new,
      }
    );
    is $s3d->credentials->aws_access_key_id, 'duckkey', 'duck-type creds';
  }

  # bad credentials object
  {

    package BadCreds;
    sub new               { bless {}, shift }
    sub aws_access_key_id {'key'}

    package main;
    eval { Amazon::S3::Lite->new( { region => 'us-east-1', credentials => BadCreds->new } ) };
    like $@, qr/must implement aws_secret_access_key/, 'bad creds object croaks';
  }

  # custom logger
  {
    my $warned = 0;
    my $logger = bless {}, 'MyLogger';
    {
      no strict 'refs';
      for my $m (qw(trace debug info error)) {
        *{"MyLogger::$m"} = sub { };
      }
      *{"MyLogger::warn"} = sub { $warned++ };
    }
    my $s3l = new_s3( logger => $logger );
    isa_ok $s3l->logger, 'MyLogger', 'custom logger accepted';
  }
};

subtest '_endpoint' => sub {
  my $s3 = new_s3();
  is $s3->_endpoint,              'https://s3.amazonaws.com',           'root endpoint';
  is $s3->_endpoint('my-bucket'), 'https://s3.amazonaws.com/my-bucket', 'bucket endpoint';
  is $s3->_endpoint( 'my-bucket', 'path/to/key.txt' ),
    'https://s3.amazonaws.com/my-bucket/path/to/key.txt',
    'bucket+key endpoint';
  is $s3->_endpoint( 'my-bucket', 'path/to/my file+thing.txt' ),
    'https://s3.amazonaws.com/my-bucket/path/to/my%20file%2Bthing.txt',
    'key encoding preserves slashes, encodes special chars';
};

subtest 'list_buckets' => sub {
  my $s3       = new_s3( region => 'eu-west-1' );
  my $captured = {};
  my $xml      = <<'XML';
<?xml version="1.0" encoding="UTF-8"?>
<ListAllMyBucketsResult xmlns="http://s3.amazonaws.com/doc/2006-03-01/">
  <Owner><ID>owner123</ID><DisplayName>rob</DisplayName></Owner>
  <Buckets>
    <Bucket><Name>bucket-a</Name><CreationDate>2024-01-01T00:00:00.000Z</CreationDate></Bucket>
    <Bucket><Name>bucket-b</Name><CreationDate>2024-06-01T00:00:00.000Z</CreationDate></Bucket>
  </Buckets>
</ListAllMyBucketsResult>
XML

  no warnings 'redefine';
  local *Amazon::S3::Lite::_request = mock_request(
    content => $xml,
    capture => \$captured,
  );

  my $r = $s3->list_buckets;

  is $captured->{method}, 'GET',                       'method is GET';
  is $captured->{url},    'https://s3.amazonaws.com/', 'hits root endpoint';
  is $captured->{region}, 'us-east-1',                 'always signs with us-east-1';
  is $s3->region,         'eu-west-1',                 'object region unchanged';

  is $r->{owner_id},            'owner123', 'owner_id';
  is $r->{owner_name},          'rob',      'owner_name';