view release on metacpan or  search on metacpan

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

        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';
  is scalar @{ $r->{buckets} }, 2,          '2 buckets';
  is $r->{buckets}[0]{name},    'bucket-a', 'first bucket name';
  is $r->{buckets}[1]{name},    'bucket-b', 'second bucket name';
  ok $r->{buckets}[0]{creation_date}, 'creation_date present';

  # error handling
  local *Amazon::S3::Lite::_request = mock_request( status => 403 );
  eval { $s3->list_buckets };
  like $@, qr/list_buckets failed/, '403 croaks';
};