view release on metacpan or  search on metacpan

t/timeout_forwarding.t  view on Meta::CPAN

  [ 'secrets->list', 'GET /secrets',
    'secrets' => sub { $_[0]->list } ],
  [ 'secrets->inspect', 'GET /secrets/s1',
    'secrets' => sub { $_[0]->inspect('s1') } ],
  [ 'secrets->remove', 'DELETE /secrets/s1',
    'secrets' => sub { $_[0]->remove('s1') } ],

  # -- configs -------------------------------------------------------------
  [ 'configs->list', 'GET /configs',
    'configs' => sub { $_[0]->list } ],
  [ 'configs->inspect', 'GET /configs/cf1',
    'configs' => sub { $_[0]->inspect('cf1') } ],
  [ 'configs->remove', 'DELETE /configs/cf1',
    'configs' => sub { $_[0]->remove('cf1') } ],

  # -- exec ----------------------------------------------------------------
  [ 'exec->start', 'POST /exec/e1/start',
    'exec' => sub { $_[0]->start('e1') } ],
  [ 'exec->resize', 'POST /exec/e1/resize',
    'exec' => sub { $_[0]->resize('e1', h => 40, w => 120) } ],
  [ 'exec->inspect', 'GET /exec/e1/json',
    'exec' => sub { $_[0]->inspect('e1') } ],

  # -- system --------------------------------------------------------------
  [ 'system->info', 'GET /info',
    'system' => sub { $_[0]->info } ],
  [ 'system->version', 'GET /version',
    'system' => sub { $_[0]->version } ],
  [ 'system->ping', 'GET /_ping',
    'system' => sub { $_[0]->ping } ],
  [ 'system->events', 'GET /events',
    'system' => sub { $_[0]->events } ],
  [ 'system->df', 'GET /system/df',
    'system' => sub { $_[0]->df } ],
  [ 'system->auth', 'POST /auth',
    'system' => sub { $_[0]->auth(username => 'u', password => 'p') } ],

  # -- plugins -------------------------------------------------------------
  [ 'plugins->list', 'GET /plugins',
    'plugins' => sub { $_[0]->list } ],
  [ 'plugins->privileges', 'GET /plugins/privileges',
    'plugins' => sub { $_[0]->privileges('p') } ],
  [ 'plugins->install', 'POST /plugins/pull',
    'plugins' => sub { $_[0]->install('p', privileges => []) } ],
  [ 'plugins->install privileges pre-flight', 'GET /plugins/privileges',
    'plugins' => sub { $_[0]->install('p', accept_privileges => 1) } ],
  [ 'plugins->inspect', 'GET /plugins/p/json',
    'plugins' => sub { $_[0]->inspect('p') } ],
  [ 'plugins->remove', 'DELETE /plugins/p',
    'plugins' => sub { $_[0]->remove('p') } ],
  [ 'plugins->enable', 'POST /plugins/p/enable',
    'plugins' => sub { $_[0]->enable('p') } ],
  [ 'plugins->disable', 'POST /plugins/p/disable',
    'plugins' => sub { $_[0]->disable('p') } ],
  [ 'plugins->upgrade', 'POST /plugins/p/upgrade',
    'plugins' => sub { $_[0]->upgrade('p', privileges => []) } ],
  [ 'plugins->upgrade privileges pre-flight', 'GET /plugins/privileges',
    'plugins' => sub { $_[0]->upgrade('p', accept_privileges => 1) } ],
  [ 'plugins->push', 'POST /plugins/p/push',
    'plugins' => sub { $_[0]->push('p') } ],
  [ 'plugins->configure', 'POST /plugins/p/set',
    'plugins' => sub { $_[0]->configure('p', ['A=1']) } ],

  # -- distribution --------------------------------------------------------
  [ 'distribution->inspect', 'GET /distribution/alpine/json',
    'distribution' => sub { $_[0]->inspect('alpine') } ],
  [ 'distribution->exists', 'GET /distribution/alpine/json',
    'distribution' => sub { $_[0]->exists('alpine') } ],
);

# The option list the named endpoint was requested with, or a string saying
# why there is none -- which is_deeply then reports instead of an empty hash.
# @using is what the resource class is cloned with; empty means it is used as
# it comes off the client.
sub opts_for {
  my ($case, @using) = @_;
  my (undef, $want, $accessor, $code) = @$case;

  my $probe = Test::TimeoutForward::Probe->new(
    host => 'unix:///nonexistent-api-docker-74.sock', api_version => '1.41');

  my $resource = $probe->$accessor;
  $resource = $resource->using(@using) if @using;

  eval { $code->($resource); 1 }
    or return 'the call died before requesting anything: ' . $@;

  my @seen;
  for my $call (@{ $probe->calls }) {
    my $endpoint = $call->{method} . ' ' . $call->{path};
    push @seen, $endpoint;
    return $call->{opts} if $endpoint eq $want;
  }
  return "never requested $want (requested: " . join(', ', @seen) . ')';
}

# What of the two the request was actually given, in a shape is_deeply can
# report: the string opts_for returns when the endpoint was never reached is
# passed through rather than turned into an empty hash.
sub bounds_of {
  my ($opts) = @_;
  return $opts unless ref $opts eq 'HASH';
  return { map { exists $opts->{$_} ? ($_ => $opts->{$_}) : () }
    qw( read_timeout connect_timeout ) };
}

# ---------------------------------------------------------------------------
subtest 'both bounds reach the request the method makes' => sub {
  for my $case (@cases) {
    is_deeply bounds_of(opts_for($case, read_timeout => 3, connect_timeout => 7)),
      { read_timeout => 3, connect_timeout => 7 },
      $case->[0] . ' carries both';
  }
};

# The subtlety `exists` buys, and the one a `? :` on truth would lose: 0 is
# "wait as long as it takes", which is how a client-wide default is turned off
# for a run of calls. Carried on truth it would vanish here and the client
# attribute would win -- the opposite of what the caller asked for.
subtest 'an explicit 0 is carried, not read as "no opinion"' => sub {
  for my $case (@cases) {
    is_deeply bounds_of(opts_for($case, read_timeout => 0, connect_timeout => 0)),