@voxgig/sdkgen 4.23.0 → 4.24.1

package/project/.sdk/tm/ocaml/sdk_runtime.ml

@@ -189,7 +189,9 @@ let make_context_impl (cs : ctxspec) (basectx : ctx option) : ctx =
       (match getp cr "actor" with Noval -> () | a -> c.ctrl_actor <- a);
       (match getp cr "paging" with Map _ as m -> c.ctrl_paging <- m | _ -> ());
       c
-    | _ -> (match basectx with Some b -> b.c_ctrl | None -> new_control ())
+    | _ -> (match basectx with
+        | Some b when cs.cs_opname = None -> b.c_ctrl
+        | _ -> new_control ())
   in
   let meta =
     match cs.cs_meta with Some (Map _ as m) -> m
@@ -413,7 +415,7 @@ let prepare_query_util (ctx : ctx) : value =
   let out = empty_map () in
   List.iter (fun k ->
       let v = getp reqmatch k in
-      if not (is_noval v) && not (contains_param k) then setp out k v)
+      if not (is_noval v) && k <> "$action" && not (contains_param k) then setp out k v)
     (keysof reqmatch);
   out
 
@@ -555,14 +557,27 @@ let prepare_auth_util = Sdk_prepare_auth.prepare_auth_util
 
 (* ----- transforms / result helpers ----- *)
 
+(* `$action` selects the point (see make_point_util); it is never an API
+   field, so the body is a copy without it. The caller's map is left
+   untouched. *)
+let strip_action (reqdata : value) : value =
+  match reqdata with
+  | Map _ when List.mem "$action" (keysof reqdata) ->
+    let body = empty_map () in
+    List.iter (fun k -> if k <> "$action" then setp body k (getp reqdata k))
+      (keysof reqdata);
+    body
+  | _ -> reqdata
+
 let transform_request_util (ctx : ctx) : value =
   (match ctx.c_spec with Some s -> s.sp_step <- "reqform" | None -> ());
-  match to_map (getp ctx.c_point "transform") with
-  | Map _ as tr ->
-    (match getp tr "req" with
-     | Noval -> ctx.c_reqdata
-     | reqform -> transform (jo [("reqdata", ctx.c_reqdata)]) reqform)
-  | _ -> ctx.c_reqdata
+  strip_action
+    (match to_map (getp ctx.c_point "transform") with
+     | Map _ as tr ->
+       (match getp tr "req" with
+        | Noval -> ctx.c_reqdata
+        | reqform -> transform (jo [("reqdata", ctx.c_reqdata)]) reqform)
+     | _ -> ctx.c_reqdata)
 
 let transform_response_util (ctx : ctx) : value =
   (match ctx.c_spec with Some s -> s.sp_step <- "resform" | None -> ());

package/project/.sdk/tm/perl/core/context.pm

@@ -45,7 +45,8 @@ sub new {
     $self->{ctrl}{actor} = $ctrl_raw->{actor} if exists $ctrl_raw->{actor};
     $self->{ctrl}{paging} = $ctrl_raw->{paging} if Voxgig::Struct::ismap($ctrl_raw->{paging});
   }
-  elsif ($basectx && $basectx->{ctrl}) {
+  elsif ($basectx && $basectx->{ctrl}
+      && !defined ProjectNameHelpers::get_ctx_prop($ctxmap, 'opname')) {
     $self->{ctrl} = $basectx->{ctrl};
   }
 

package/project/.sdk/tm/perl/feature/paging_feature.pm

@@ -4,8 +4,8 @@
 # stamps page/limit (or a cursor) into the request query; on the way back
 # (PreResult) it reads the server's pagination signals - a Link rel="next"
 # header, X-Page/X-Next-Page/X-Total-Count headers, or next/cursor/
-# nextCursor/hasMore fields in the body - and records them on
-# result.paging. A per-call ctrl paging value (page or cursor) takes
+# nextCursor/hasMore fields in the body (snake_case forms too) - and records
+# them on result.paging and the caller's ctrl paging. A per-call ctrl paging value (page or cursor) takes
 # priority. Parameter names ("pageParam", "limitParam", "cursorParam"),
 # "startPage" (default 1) and page size ("limit") are configurable.
 
@@ -76,8 +76,11 @@ sub PreRequest {
     $spec->{query}{$cursor_param} = $paging->{cursor};
   }
   elsif (!defined $spec->{query}{$page_param}) {
-    $spec->{query}{$page_param} = defined $paging->{page}
-      ? $paging->{page}
+    # A record written back by PreResult holds the page just fetched as
+    # "page" and the one to fetch as "nextPage", so nextPage wins.
+    my $page = defined $paging->{nextPage} ? $paging->{nextPage} : $paging->{page};
+    $spec->{query}{$page_param} = defined $page
+      ? $page
       : (defined $self->{options}{startPage} ? $self->{options}{startPage} : 1);
   }
 
@@ -186,15 +189,27 @@ sub PreResult {
     }
   }
 
-  # Body-level cursors.
+  # Body-level signals; snake_case forms are read first so camelCase wins.
   if (Voxgig::Struct::ismap($body)) {
     my $bnext = ProjectNameHelpers::gp($body, 'next');
     $paging->{next} = defined $paging->{next} ? $paging->{next} : $bnext
       if defined $bnext;
+    my $bsnakecursor = ProjectNameHelpers::gp($body, 'next_cursor');
+    $paging->{cursor} = $bsnakecursor if defined $bsnakecursor;
     my $bcursor = ProjectNameHelpers::gp($body, 'cursor');
     $paging->{cursor} = $bcursor if defined $bcursor;
     my $bnextcursor = ProjectNameHelpers::gp($body, 'nextCursor');
     $paging->{cursor} = $bnextcursor if defined $bnextcursor;
+    unless (defined $paging->{nextPage}) {
+      my $np = ProjectNameHelpers::gp($body, 'nextPage');
+      $np = ProjectNameHelpers::gp($body, 'next_page') unless defined $np;
+      $paging->{nextPage} = $np if defined $np && !ref($np);
+    }
+    my $bsnakemore = $body->{has_more};
+    if (ProjectNameHelpers::is_true($bsnakemore) || ProjectNameHelpers::is_false($bsnakemore)) {
+      $paging->{hasMore} = ProjectNameHelpers::is_true($bsnakemore) ? 1 : 0;
+      $explicit_more = 1;
+    }
     my $bhasmore = $body->{hasMore};
     if (ProjectNameHelpers::is_true($bhasmore) || ProjectNameHelpers::is_false($bhasmore)) {
       $paging->{hasMore} = ProjectNameHelpers::is_true($bhasmore) ? 1 : 0;
@@ -215,6 +230,17 @@ sub PreResult {
 
   $result->{paging} = $paging;
 
+  if ($ctx->{ctrl}) {
+    # The Context shares the caller's paging hash by reference, so refill it
+    # in place; a fresh hash on ctrl never reaches the caller.
+    if (Voxgig::Struct::ismap($ctx->{ctrl}{paging})) {
+      %{ $ctx->{ctrl}{paging} } = %$paging;
+    }
+    else {
+      $ctx->{ctrl}{paging} = $paging;
+    }
+  }
+
   $self->{client}{_paging} = { 'last' => $paging };
   return;
 }

package/project/.sdk/tm/perl/feature/test_feature.pm

@@ -154,18 +154,11 @@ sub init {
       my $args = $test_self->build_args($fctx, $op, $update_match);
       my $found = Voxgig::Struct::select($entmap, $args);
       my $ent = ProjectNameHelpers::ge($found, 0);
-      if (!defined $ent && Voxgig::Struct::ismap($entmap) && keys %$entmap) {
-        for my $k (sort keys %$entmap) {
-          if (Voxgig::Struct::ismap($entmap->{$k})) {
-            $ent = $entmap->{$k};
-            last;
-          }
-        }
-      }
+      # update miss: 404, never another record
       return $respond->($fctx, 404, undef, { 'statusText' => 'Not found' })
         unless ProjectNameHelpers::rb_truthy($ent);
-      if (Voxgig::Struct::ismap($ent) && $fctx->{reqdata}) {
-        $ent->{$_} = $fctx->{reqdata}{$_} for keys %{ $fctx->{reqdata} };
+      if (Voxgig::Struct::ismap($ent) && Voxgig::Struct::ismap($fctx->{reqdata})) {
+        Voxgig::Struct::merge([$ent, $fctx->{reqdata}]);
       }
       Voxgig::Struct::delprop($ent, '$KEY');
       my $out = Voxgig::Struct::clone($ent);
@@ -290,18 +283,55 @@ sub make_netsim {
   };
 }
 
+sub _point_terminal {
+  my ($p) = @_;
+  my $parts = ProjectNameHelpers::gp($p, 'parts');
+  return 0 unless Voxgig::Struct::islist($parts) && @$parts;
+  my $last = $parts->[-1];
+  return (defined $last && !ref $last && 0 == index($last, '{')) ? 1 : 0;
+}
+
+sub _point_depth {
+  my ($p) = @_;
+  my $parts = ProjectNameHelpers::gp($p, 'parts');
+  return Voxgig::Struct::islist($parts) ? scalar @$parts : 0;
+}
+
+# The entity's own endpoint: a terminal `{param}` marks a record route, and
+# among equals the shallower path wins (the same rule as make_point).
+sub _pick_point {
+  my ($points) = @_;
+  return undef unless Voxgig::Struct::islist($points) && @$points;
+  my $point = $points->[0];
+  for my $cand (@$points[1 .. $#$points]) {
+    if (_point_terminal($cand) != _point_terminal($point)) {
+      $point = $cand if _point_terminal($cand);
+    }
+    elsif (_point_depth($cand) < _point_depth($point)) {
+      $point = $cand;
+    }
+  }
+  return $point;
+}
+
 sub build_args {
   my ($self, $ctx, $op, $args) = @_;
   my $opname = $op->{name};
   my $entname = $ctx->{entity}->get_name;
   my $points = ProjectNameHelpers::gpath($ctx->{config},
     "entity.$entname.op.$opname.points");
-  my $point = ProjectNameHelpers::ge($points, -1);
-
-  my $params_path = ProjectNameHelpers::gpath($point, 'args.params');
-  my $reqd_params = Voxgig::Struct::select($params_path,
-    { 'reqd' => Voxgig::Struct::JTRUE() });
-  my $reqd = Voxgig::Struct::transform($reqd_params, ['`$EACH`', '', '`$KEY.name`']);
+  my $point = _pick_point($points);
+
+  # Path AND query: a path-only read misses a query-addressed record
+  # (e.g. GET /result?trace_id=), which has no path param at all.
+  my $reqd = [];
+  for my $kind ('params', 'query') {
+    my $args_path = ProjectNameHelpers::gpath($point, "args.$kind");
+    my $reqd_args = Voxgig::Struct::select($args_path,
+      { 'reqd' => Voxgig::Struct::JTRUE() });
+    my $names = Voxgig::Struct::transform($reqd_args, ['`$EACH`', '', '`$KEY.name`']);
+    push @$reqd, @$names if Voxgig::Struct::islist($names);
+  }
 
   my $qand = [];
   my $q = { '`$AND`' => $qand };

package/project/.sdk/tm/perl/feature/timeout_feature.pm

@@ -3,9 +3,11 @@
 # Per-request timeout. Wraps the active transport with a deadline of "ms"
 # milliseconds (default 30000; <= 0 disables). The transport is synchronous
 # (HTTP::Tiny), so a hanging request is interrupted with a SIGALRM timer
-# (Time::HiRes::ualarm); when an injectable "now" clock is supplied the
-# elapsed wall-clock time is checked instead, so tests can assert the
-# deadline deterministically. Expiry yields an error with code "timeout".
+# (Time::HiRes::ualarm) where the platform has one; where it has none
+# (Windows) the deadline is checked once the call returns. When an
+# injectable "now" clock is supplied the elapsed clock time is checked
+# instead, so tests can assert the deadline deterministically. Expiry
+# yields an error with code "timeout".
 
 use strict;
 use warnings;
@@ -75,24 +77,26 @@ sub with_timeout {
   # Live path: interrupt a hanging synchronous transport.
   my ($res, $err);
   my $timed_out = 0;
-  my $ok = do {
-    local $SIG{ALRM} = sub { $timed_out = 1; die "ProjectNameTimeout\n" };
-    eval {
-      Time::HiRes::ualarm(int($ms * 1000));
-      ($res, $err) = $inner->($ctx, $url, $fetchdef);
-      Time::HiRes::ualarm(0);
-      1;
-    };
+  my $start = Time::HiRes::time();
+  local $SIG{ALRM} = sub { $timed_out = 1; die "ProjectNameTimeout\n" };
+  my $armed = eval { Time::HiRes::ualarm(int($ms * 1000)); 1 };
+  my $ok = eval {
+    ($res, $err) = $inner->($ctx, $url, $fetchdef);
+    1;
   };
-  Time::HiRes::ualarm(0);
+  my $e = $@;
+  eval { Time::HiRes::ualarm(0) } if $armed;
   if (!$ok) {
-    my $e = $@;
     if ($timed_out) {
       $self->_track($ctx, $ms);
       return (undef, $ctx->make_error('timeout', "Request exceeded timeout of ${ms}ms"));
     }
     die $e;
   }
+  if (!$armed && (Time::HiRes::time() - $start) * 1000 > $ms) {
+    $self->_track($ctx, $ms);
+    return (undef, $ctx->make_error('timeout', "Request exceeded timeout of ${ms}ms"));
+  }
   return ($res, $err);
 }
 

package/project/.sdk/tm/perl/t/feature_corpus.t

@@ -267,6 +267,15 @@ sub subset {
 }
 
 
+# Whether the SDK built the feature at all. The activity record is the
+# wrong probe: most features create theirs on first use, so an idle client
+# has none and every section but the eager ones read as inert.
+sub present {
+  my ($client, $name) = @_;
+  return scalar grep { ref $_ && ($_->{name} // '') eq $name }
+    @{ $client->{features} || [] };
+}
+
 sub record {
   my ($client, $name) = @_;
   return $client->{"_$name"};
@@ -295,7 +304,11 @@ for my $name (sort keys %{ $CORPUS->{feature} || {} }) {
   # Probed by ACTIVATING it: the feature defaults to inactive, so an idle
   # client never builds it and its absence says nothing.
   my $probe = build_client({ feature => [ { name => $name, active => 1 } ] });
-  next unless defined record($probe, $name);
+  unless (present($probe, $name)) {
+    # The one line every runner prints for an inert section.
+    diag("feature.$name: inert (this SDK does not generate the feature)");
+    next;
+  }
 
   my %by_key = map { $_->{key} => $_ } @ops;
 

package/project/.sdk/tm/perl/t/omni.pm

@@ -587,7 +587,13 @@ sub make_runner {
   my ($testfile, $client) = @_;
 
   my $specref = $testfile;
-  if (defined $testfile && !ref $testfile && $testfile !~ m{^/}) {
+  # A leading slash alone is not the whole of absolute: a Windows path
+  # starts `C:/` or `\\host\share`, and joining one onto $DIR reads
+  # nothing. Spelled out rather than left to File::Spec, which an MSYS perl
+  # resolves to the Unix flavour and which answers no for a drive letter.
+  if (defined $testfile && !ref $testfile
+    && $testfile !~ m{^/} && $testfile !~ m{^[A-Za-z]:[\\/]}
+    && $testfile !~ m{^\\\\}) {
     $specref = Cwd::abs_path("$DIR/$testfile") || "$DIR/$testfile";
   }
 

package/project/.sdk/tm/perl/t/pipeline.t

@@ -551,60 +551,157 @@ sub named_feature {
 
 # === prepare_auth ===
 
+# A cookie credential as prepare_auth writes it: `<scheme>=K` for the probe
+# key, with no scheme prefix and nothing else in the bag.
+sub _is_cookie_pair {
+  my ($value) = @_;
+  return (defined $value && !ref $value && $value =~ m{^[^=;]+=K$}) ? 1 : 0;
+}
+
 sub auth_ctx {
-  my ($options, $headers) = @_;
+  my ($options, $spec) = @_;
   my $ctx = ProjectNameContext->new({
     'client' => PipelineOptClient->new($options),
     'utility' => $utility,
     'opname' => 'load',
   }, undef);
-  $ctx->{spec} = defined $headers
-    ? ProjectNameSpec->new({ 'headers' => $headers, 'step' => 's' })
-    : undef;
+  $ctx->{spec} = $spec;
   return $ctx;
 }
 
+sub auth_bags {
+  return ProjectNameSpec->new({ 'headers' => {}, 'query' => {}, 'step' => 's' });
+}
+
+# A cookie credential rides the header bag, because a cookie IS a header.
+sub auth_bag {
+  my ($spec, $where) = @_;
+  return 'query' eq $where ? $spec->{query} : $spec->{headers};
+}
+
+# `basic: false` is explicit: an HTTP Basic API's generated config carries
+# `auth.basic: true`, and a client that merges it in takes a branch that needs
+# a secret as well. With none supplied that branch deliberately writes
+# nothing, which the probe would read as a public API.
+sub auth_block {
+  my ($prefix) = @_;
+  return { 'prefix' => $prefix, 'basic' => 0 };
+}
+
+# Run prepare_auth with both containers present and see which one the
+# generated utility writes to, and under what name. undef means this SDK
+# places no credential at all - a public API - which is a legitimate shape,
+# and the tests below assert exactly that instead. `pair` is the `<scheme>=`
+# lead-in of a COOKIE credential, which rides the header bag under the key
+# `cookie` instead of taking a header of its own.
+sub auth_probe {
+  my ($options) = @_;
+  my $ctx = auth_ctx($options, auth_bags());
+  $utility->{prepare_auth}->($ctx);
+  for my $where ('headers', 'query') {
+    my $bag = auth_bag($ctx->{spec}, $where);
+    for my $name (keys %{ $bag || {} }) {
+      my $value = $bag->{$name};
+      my $pair = '';
+      if ('headers' eq $where && 'cookie' eq $name && _is_cookie_pair($value)) {
+        $pair = substr($value, 0, -1);
+      }
+      return { 'where' => $where, 'name' => $name,
+        'value' => $value, 'pair' => $pair };
+    }
+  }
+  return undef;
+}
+
+sub auth_credential {
+  return auth_probe({ 'apikey' => 'K', 'auth' => auth_block('Bearer') });
+}
+
+# Every credential this SDK could possibly place: both credentials and Basic
+# switched on, so whichever branch the API has, something lands unless the API
+# is public.
+sub auth_any_credential {
+  return auth_probe({ 'apikey' => 'K', 'secret' => 'S',
+    'auth' => { 'prefix' => 'Bearer', 'basic' => 1 } });
+}
+
+# Returns the value left in the credential slot, and whether it is there.
+sub auth_placed {
+  my ($options, $seed) = @_;
+  my $cred = auth_credential();
+  my $spec = auth_bags();
+  if (defined $cred && defined $seed) {
+    auth_bag($spec, $cred->{where})->{ $cred->{name} } = $seed;
+  }
+  my $ctx = auth_ctx($options, $spec);
+  $utility->{prepare_auth}->($ctx);
+  return (undef, 0) if !defined $cred;
+  my $bag = auth_bag($ctx->{spec}, $cred->{where});
+  return ($bag->{ $cred->{name} }, exists $bag->{ $cred->{name} } ? 1 : 0);
+}
+
 {
-  my $ctx = auth_ctx({ 'auth' => { 'prefix' => '' }, 'apikey' => 'K' }, undef);
+  my $ctx = auth_ctx({ 'auth' => auth_block(''), 'apikey' => 'K' }, undef);
   my (undef, $err) = $utility->{prepare_auth}->($ctx);
   is($err->{code}, 'auth_no_spec', 'prepare_auth guards a missing spec');
 }
 
+# Without this the cases below cannot fail for an SDK whose credential the
+# probe misses: every one of them takes the public-API path instead.
 {
-  my $ctx = auth_ctx({ 'apikey' => 'K', 'auth' => { 'prefix' => 'Bearer' } }, {});
-  my (undef, $err) = $utility->{prepare_auth}->($ctx);
-  ok(!defined $err, 'prepare_auth prefix: no error');
-  is($ctx->{spec}{headers}{authorization}, 'Bearer K',
-    'prepare_auth an apikey with a prefix is space-joined');
+  is(defined auth_credential() ? 1 : 0, defined auth_any_credential() ? 1 : 0,
+    'prepare_auth probe finds the credential this SDK places');
 }
 
 {
-  my $ctx = auth_ctx({ 'apikey' => 'K', 'auth' => { 'prefix' => '' } }, {});
-  $utility->{prepare_auth}->($ctx);
-  is($ctx->{spec}{headers}{authorization}, 'K', 'prepare_auth a raw apikey goes in as-is');
+  my $cred = auth_credential();
+  if (!defined $cred) {
+    # A public API places nothing, and that is the whole assertion.
+    my (undef, $has) =
+      auth_placed({ 'apikey' => 'K', 'auth' => auth_block('Bearer') });
+    ok(!$has, 'prepare_auth places no credential for a public API');
+  }
+  elsif ('' ne $cred->{pair}) {
+    # A cookie credential is a `<scheme>=<key>` pair, and the scheme name
+    # leaves no room for the option's prefix.
+    ok(_is_cookie_pair($cred->{value}),
+      'prepare_auth places the apikey as a cookie pair');
+  }
+  else {
+    ok('headers' eq $cred->{where} || 'query' eq $cred->{where},
+      'prepare_auth places the credential in headers or query');
+    # A header credential is prefix-joined; a query credential is the raw
+    # key, because a query parameter has nowhere to put a scheme name.
+    is($cred->{value}, 'query' eq $cred->{where} ? 'K' : 'Bearer K',
+      'prepare_auth places the apikey where this API puts it');
+  }
 }
 
 {
-  my $ctx = auth_ctx({ 'apikey' => '', 'auth' => { 'prefix' => 'Bearer' } },
-    { 'authorization' => 'stale' });
-  $utility->{prepare_auth}->($ctx);
-  ok(!exists $ctx->{spec}{headers}{authorization},
-    'prepare_auth an empty apikey drops the header');
+  my ($value, $has) = auth_placed({ 'apikey' => 'K', 'auth' => auth_block('') });
+  my $cred = auth_credential();
+  if (defined $cred) {
+    is($value, $cred->{pair} . 'K', 'prepare_auth a raw apikey goes in as-is');
+  }
+  else {
+    ok(!$has, 'prepare_auth a raw apikey places nothing for a public API');
+  }
 }
 
 {
-  my $ctx = auth_ctx({ 'apikey' => 'K' }, { 'authorization' => 'stale' });
-  $utility->{prepare_auth}->($ctx);
-  ok(!exists $ctx->{spec}{headers}{authorization},
-    'prepare_auth a public api drops the header');
+  my (undef, $has) =
+    auth_placed({ 'apikey' => '', 'auth' => auth_block('Bearer') }, 'stale');
+  ok(!$has, 'prepare_auth an empty apikey drops the credential');
 }
 
 {
-  my $ctx = auth_ctx({ 'auth' => { 'prefix' => 'Bearer' } },
-    { 'authorization' => 'stale' });
-  $utility->{prepare_auth}->($ctx);
-  ok(!exists $ctx->{spec}{headers}{authorization},
-    'prepare_auth a missing apikey option drops the header');
+  my (undef, $has) = auth_placed({ 'apikey' => 'K' }, 'stale');
+  ok(!$has, 'prepare_auth a public api drops the credential');
+}
+
+{
+  my (undef, $has) = auth_placed({ 'auth' => auth_block('Bearer') }, 'stale');
+  ok(!$has, 'prepare_auth a missing apikey option drops the credential');
 }
 
 

package/project/.sdk/tm/perl/t/primary_utility.t

@@ -200,6 +200,64 @@ sub _def_setup {
 }
 
 
+# Where this SDK's prepare_auth actually puts the credential: the name is the
+# API's OWN scheme name, not always `authorization`, so it is discovered by
+# running prepare_auth once.
+sub _auth_credential {
+  my ($auth_client) = @_;
+  my $auth_utility = $auth_client->get_utility;
+  my $ctx = ProjectNameContext->new({
+    'client' => $auth_client,
+    'utility' => $auth_utility,
+    'opname' => 'load',
+  }, undef);
+  # The DEF setup this client is built from carries `auth.basic: false`, so
+  # the single-token branch runs and there is a credential to find.
+  $ctx->{spec} = ProjectNameSpec->new({
+    'headers' => {}, 'query' => {}, 'step' => 's' });
+  my (undef, $err) = $auth_utility->{prepare_auth}->($ctx);
+  return undef if defined $err;
+  for my $where ('headers', 'query') {
+    # A cookie credential rides the header bag, because a cookie IS a header.
+    my $bag = 'query' eq $where ? $ctx->{spec}{query} : $ctx->{spec}{headers};
+    for my $name (keys %{ $bag || {} }) {
+      return { 'where' => $where, 'name' => $name };
+    }
+  }
+  return undef;
+}
+
+
+# Rename the corpus's `headers` bag to the real container, and the
+# `authorization` key inside it to the real credential name. Applied only to
+# the prepareAuth section, so real header assertions elsewhere are untouched.
+sub _retarget_auth {
+  my ($node, $cred) = @_;
+
+  if (ref($node) eq 'ARRAY') {
+    return [ map { _retarget_auth($_, $cred) } @$node ];
+  }
+  return $node unless ref($node) eq 'HASH';
+
+  my $out = {};
+  for my $key (keys %$node) {
+    if ('headers' eq $key) {
+      my $bag = {};
+      my $inner = ref($node->{$key}) eq 'HASH' ? $node->{$key} : {};
+      for my $bagkey (keys %$inner) {
+        my $name = 'authorization' eq $bagkey ? $cred->{name} : $bagkey;
+        $bag->{$name} = _retarget_auth($inner->{$bagkey}, $cred);
+      }
+      $out->{ $cred->{where} } = $bag;
+    }
+    else {
+      $out->{$key} = _retarget_auth($node->{$key}, $cred);
+    }
+  }
+  return $out;
+}
+
+
 # === exists ===
 
 for my $name (qw(
@@ -606,12 +664,27 @@ runsection('param', sub {
 {
   my $auth_client = ProjectNameSDK->test(undef, _def_setup('prepareAuth'));
 
+  # The corpus writes the credential as `headers.authorization`: a
+  # PLACEHOLDER each runner points at the container and name this API
+  # actually uses.
+  my $cred = _auth_credential($auth_client);
+  ok(defined $cred, 'prepare_auth placed a credential in headers or query');
+
+  # An absent section is runsection's report to make.
+  my $section = ref($spec) eq 'HASH' ? $spec->{prepareAuth} : undef;
+  my $swap = ref($section) eq 'HASH' && defined $cred
+    && !('headers' eq $cred->{where} && 'authorization' eq $cred->{name});
+  my $original = $swap ? $section->{basic} : undef;
+  $section->{basic} = _retarget_auth($original, $cred) if $swap;
+
   runsection('prepareAuth', sub {
     my ($view) = @_;
     my $ctx = ProjectNameOmni::livectx($view);
     $ctx->{client} = $auth_client;
     return _unwrap($utility->{prepare_auth}->($ctx));
   });
+
+  $section->{basic} = $original if $swap;
 }
 
 

package/project/.sdk/tm/perl/utility/fetcher.pm

@@ -16,6 +16,16 @@ package ProjectNameUtilities;
 
 our %REGISTRY;
 
+# One HTTP::Tiny per (proxy, redirect) setting: a client keeps its
+# connection alive between requests, so one per request reused nothing.
+my %HTTP_CLIENTS;
+
+sub _http_client {
+  my (%new_args) = @_;
+  my $key = join "\n", map { "$_=$new_args{$_}" } sort keys %new_args;
+  return $HTTP_CLIENTS{$key} //= HTTP::Tiny->new(%new_args);
+}
+
 our $DefaultHttpFetch = sub {
   my ($fullurl, $fetchdef) = @_;
   $fetchdef = {} unless defined $fetchdef;
@@ -47,8 +57,12 @@ our $DefaultHttpFetch = sub {
   $new_args{max_redirect} = 0
     if defined $fetchdef->{redirect} && !ref $fetchdef->{redirect}
       && 'manual' eq $fetchdef->{redirect};
+  # Both keys: HTTP::Tiny lets the environment override its generic proxy.
+  $new_args{http_proxy} = $new_args{https_proxy} = "$fetchdef->{proxy}"
+    if defined $fetchdef->{proxy} && !ref $fetchdef->{proxy}
+      && length $fetchdef->{proxy};
 
-  my $res = eval { HTTP::Tiny->new(%new_args)->request($method, $fullurl, $opts) };
+  my $res = eval { _http_client(%new_args)->request($method, $fullurl, $opts) };
   if (!$res) {
     my $e = defined $@ ? "$@" : 'request failed';
     $e =~ s/\s+\z//;

package/project/.sdk/tm/perl/utility/prepare_query.pm

@@ -30,6 +30,7 @@ $REGISTRY{prepare_query} = sub {
     for my $item (@$items) {
       my ($key, $val) = @$item;
       next unless ProjectNameHelpers::rb_truthy($val) && defined $key && !ref $key;
+      next if '$action' eq $key;
       next if grep { defined $_ && !ref $_ && $_ eq $key } @$params;
       $out->{$key} = $val;
     }