view release on metacpan or  search on metacpan

t/type.t  view on Meta::CPAN

    'a Bool that was never set is absent, not false');
  my $explicit = API::Docker::Type::Mount->new(target => '/x', read_only => 0);
  ok(exists $explicit->TO_JSON->{ReadOnly},
    'a Bool explicitly set to false is present and false');
  is($json->encode($explicit->TO_JSON), '{"ReadOnly":false,"Target":"/x"}',
    'and encodes as JSON false, never as 1 or the empty string');
  like(
    do { local $@; eval { API::Docker::Type::Mount->new(read_only => [1]) }; $@ },
    qr/Bool wants a scalar/,
    'something that cannot mean true or false croaks instead of being guessed at');
};

# ---------------------------------------------------------------------------
# Nesting, arrays of objects, and the allOf inheritance
# ---------------------------------------------------------------------------

subtest 'nested objects and arrays' => sub {
  my $hc = API::Docker::Type::HostConfig->from_data({
    RestartPolicy       => { Name => 'on-failure', MaximumRetryCount => 3 },
    LogConfig           => { Type => 'json-file', Config => { 'max-size' => '10m' } },
    Mounts              => [ { Target => '/data', Type => 'volume' } ],
    Ulimits             => [ { Name => 'nofile', Soft => 1024, Hard => 2048 } ],
    BlkioDeviceReadIOps => [ { Path => '/dev/sda', Rate => 100 } ],
    Devices             => [ { PathOnHost => '/dev/x', PathInContainer => '/dev/x' } ],
    ConsoleSize         => [ 80, 64 ],
  });
  isa_ok($hc->restart_policy, 'API::Docker::Type::RestartPolicy');
  isa_ok($hc->log_config,     'API::Docker::Type::HostConfig::LogConfig');
  isa_ok($hc->mounts->[0],    'API::Docker::Type::Mount');
  isa_ok($hc->ulimits->[0],   'API::Docker::Type::Resources::Ulimit');
  isa_ok($hc->blkio_device_read_iops->[0], 'API::Docker::Type::ThrottleDevice');
  isa_ok($hc->devices->[0],   'API::Docker::Type::DeviceMapping');
  is($hc->ulimits->[0]->soft, 1024, 'an inline array element inflates');
  is_deeply($hc->console_size, [ 80, 64 ], 'an array of scalars stays an array of scalars');

  my $mount = API::Docker::Type::Mount->from_data({
    TmpfsOptions => { Options => [ ['noexec'], [ 'size', '64m' ] ] },
  });
  is_deeply($mount->tmpfs_options->options, [ ['noexec'], [ 'size', '64m' ] ],
    'an array of arrays of strings survives');

  my $built = API::Docker::Type::HostConfig->new(
    restart_policy => API::Docker::Type::RestartPolicy->new(name => 'always'),
  );
  is_deeply($built->TO_JSON, { RestartPolicy => { Name => 'always' } },
    'an object built by hand serialises the same way an inflated one does');
};

subtest 'allOf becomes inheritance' => sub {
  ok(API::Docker::Type::HostConfig->isa('API::Docker::Type::Resources'),
    'HostConfig is a Resources, because the swagger says allOf [ $ref Resources, ... ]');
  my $order = API::Docker::Type::HostConfig->docker_attribute_order;
  is(scalar @$order, 70, 'HostConfig carries 31 inherited plus 39 of its own');
  is($order->[0], 'cpu_shares', 'the inherited fields come first, as the allOf lists them');
  is($order->[31], 'binds', 'and the class own fields follow in spec order');
  my $hc = API::Docker::Type::HostConfig->from_data({ CpuShares => 512, Binds => ['/a:/b'] });
  is($hc->cpu_shares, 512, 'an inherited field inflates on the child');
  is_deeply($hc->TO_JSON, { CpuShares => 512, Binds => ['/a:/b'] },
    'and serialises flat, the way it sits on the wire');
  is(scalar @{ API::Docker::Type::Resources->docker_attribute_order }, 31,
    'the parent is unaffected by the child');
};

# ---------------------------------------------------------------------------
# Both spellings, and what the DSL refuses
# ---------------------------------------------------------------------------

subtest 'constructor accepts both spellings' => sub {
  my $a = API::Docker::Type::Port->new(private_port => 80, type => 'tcp');
  my $b = API::Docker::Type::Port->from_data({ PrivatePort => 80, Type => 'tcp' });
  is($json->encode($a->TO_JSON), $json->encode($b->TO_JSON),
    'a Perl name and a wire name reach the same attribute');
  is_deeply($a->unknown_fields, {}, 'and neither is filed as unknown');
  like(
    do { local $@; eval { API::Docker::Type::Port->from_data([]) }; $@ },
    qr/needs a HashRef/, 'from_data refuses anything but a hashref');
};

subtest 'the registry is what the drift checker reads' => sub {
  my $reg = API::Docker::Type::HostConfig->docker_attributes;
  is(API::Docker::Type::describe_type($reg->{port_bindings}{type}),
    'hash<array<object<API::Docker::Type::PortBinding>>>',
    'a PortMap is a hash of arrays of typed objects');
  is(API::Docker::Type::describe_type($reg->{binds}{type}), 'array<str>',
    'and Binds an array of strings');
  is(API::Docker::Type::describe_type($reg->{privileged}{type}), 'bool');
  is(API::Docker::Type::describe_type($reg->{log_config}{type}),
    'object<API::Docker::Type::HostConfig::LogConfig>',
    'an inline schema is a class named after the definition declaring it');
  is($reg->{port_bindings}{required}, 0, 'required is recorded');
  is(API::Docker::Type::Port->docker_attributes->{private_port}{required}, 1,
    'including where the spec sets it');
  is_deeply(API::Docker::Type::Mount->docker_attributes->{type}{enum},
    [qw( bind cluster image npipe tmpfs volume )],
    'and an enumeration, for the POD to state');
};

# ---------------------------------------------------------------------------
# The two entry points have different jobs (karr k85)
# ---------------------------------------------------------------------------

subtest 'from_data reads a response, so a key it does not know stays a key' => sub {
  # A decoded daemon response is a map of WIRE names, and the swagger spells
  # 114 of them with a lowercase first letter -- BuildInfo.id among them. So
  # a lowercase key off an engine is ordinary, not exotic, and reading it as
  # the Perl spelling of a field we happen to know renames the engine's data.
  my $both = API::Docker::Type::ContainerInspectResponse->from_data({
    Id => 'known', id => 'lowercase-new-field' });
  is($both->id, 'known', 'the wire name Id is what fills the id attribute');
  is_deeply($both->unknown_fields, { id => 'lowercase-new-field' },
    'and a key that is only a Perl spelling is a field we have not heard of');
  is_deeply($both->TO_JSON, { Id => 'known', id => 'lowercase-new-field' },
    'both go back out under the name they arrived with');

  my $only = API::Docker::Type::ContainerInspectResponse->from_data({
    id => 'lowercase-new-field' });
  is($only->id, undef, 'an unknown key fills no attribute');
  is_deeply($only->TO_JSON, { id => 'lowercase-new-field' },
    'and is not rewritten to Id on the way out');

  # The same one level down: the coercion that inflates a nested hashref is