@voxgig/sdkgen 4.34.0 → 4.34.2

package/project/.sdk/tm/lua/utility/transform_request.lua

@@ -32,16 +32,29 @@ local function strip_action(reqdata)
   return omit(reqdata, { "$action" })
 end
 
--- A header argument travels as a header, which prepare_headers_util sends, so
--- the body is built from the request data without it.
-local function header_arg_names(point)
+local function field_arg(ctx, name)
+  for _, kind in ipairs({ "header", "cookie", "query" }) do
+    local defs = ctx.point ~= nil and vs.getpath(ctx.point, "args." .. kind) or nil
+    if type(defs) == "table" then
+      for _, ad in ipairs(defs) do
+        if vs.getprop(ad, "name") == name and vs.getprop(ad, "field") == true then
+          return true
+        end
+      end
+    end
+  end
+  return false
+end
+
+-- A header, cookie or query argument travels where prepare_headers_util or
+-- prepare_query_util sends it, so the body is built from the request data
+-- without it, unless the point marks it as a field the body keeps.
+local function routed_arg_names(ctx)
   local names = {}
-  local hl = point ~= nil and vs.getpath(point, "args.header") or nil
-  if type(hl) == "table" then
-    for _, hd in ipairs(hl) do
-      local name = vs.getprop(hd, "name")
-      if type(name) == "string" and name ~= "" then
-        names[#names + 1] = name
+  for _, kind in ipairs({ "header", "cookie", "query" }) do
+    for _, arg in ipairs(helpers.call_args(ctx, kind)) do
+      if not field_arg(ctx, arg.name) then
+        names[#names + 1] = arg.name
       end
     end
   end
@@ -56,7 +69,7 @@ local function transform_request_util(ctx)
     spec.step = "reqform"
   end
 
-  local data = omit(ctx.reqdata, header_arg_names(point))
+  local data = omit(ctx.reqdata, routed_arg_names(ctx))
 
   local transform = helpers.to_map(vs.getprop(point, "transform"))
   if transform == nil then

package/project/.sdk/tm/lua/utility/unreadable_body.lua

@@ -0,0 +1,70 @@
+-- ProjectName SDK utility: unreadable_body
+
+local PREVIEW_LENGTH = 160
+
+
+local function header_value(headers, name)
+  if type(headers) ~= "table" then
+    return ""
+  end
+  for k, v in pairs(headers) do
+    if string.lower(tostring(k)) == name then
+      return tostring(v)
+    end
+  end
+  return ""
+end
+
+
+-- Cleaned whole: a secret the bound would split could leave its prefix.
+local function preview(ctx, text)
+  local flat = (string.gsub(tostring(text), "%s+", " "))
+  flat = (string.gsub(flat, "^ ", ""))
+  flat = (string.gsub(flat, " $", ""))
+  flat = tostring(ctx.utility.clean(ctx, flat))
+  local count = utf8.len(flat)
+  if count == nil then
+    if #flat > PREVIEW_LENGTH then
+      return string.sub(flat, 1, PREVIEW_LENGTH) .. "..."
+    end
+    return flat
+  end
+  if count > PREVIEW_LENGTH then
+    return string.sub(flat, 1, utf8.offset(flat, PREVIEW_LENGTH + 1) - 1) .. "..."
+  end
+  return flat
+end
+
+
+-- A body that is not JSON. An HTTP failure keeps its own error, with the
+-- response described; otherwise the code tells a wrong content type from
+-- malformed JSON.
+local function unreadable_body(ctx, status, headers, text, sent, failed)
+  local ctype = header_value(headers, "content-type")
+  local agent = ctx.utility.clean(ctx, header_value(sent, "user-agent"))
+  if agent == nil or agent == "" then
+    agent = "transport default"
+  end
+  local detail = "HTTP " .. tostring(status) .. ", content-type " ..
+    (ctype == "" and "none" or ctype) .. ", user-agent " .. tostring(agent)
+  if text ~= nil then
+    detail = detail .. ", body: " .. preview(ctx, text)
+  end
+
+  if failed ~= nil then
+    if type(failed) == "table" and type(failed.msg) == "string" then
+      failed.msg = failed.msg .. " (" .. detail .. ")"
+      return failed
+    end
+    return tostring(failed) .. " (" .. detail .. ")"
+  end
+
+  if ctype == "" or string.find(string.lower(ctype), "json", 1, true) then
+    return ctx:make_error("response_json_invalid",
+      "response: body is not valid JSON (" .. detail .. ")")
+  end
+  return ctx:make_error("response_content_type",
+    "response: expected JSON, got " .. ctype .. " (" .. detail .. ")")
+end
+
+return unreadable_body

package/project/.sdk/tm/ocaml/LICENSE

@@ -1,6 +1,6 @@
 MIT License
 
-Copyright (c) 2025 voxgig
+Copyright (c) $$const.year$$ PROJECTPUBLISHER
 
 Permission is hereby granted, free of charge, to any person obtaining a copy
 of this software and associated documentation files (the "Software"), to deal

package/project/.sdk/tm/ocaml/Makefile

@@ -1,11 +1,12 @@
 # Makefile for the ProjectName OCaml SDK (generated by @voxgig/sdkgen).
 #
 # The SDK is dependency-free: it compiles with the stock bytecode compiler
-# (ocamlc) — no opam packages, no dune. Four test executables are built:
-#   run_sdk_test        — the SDK pipeline + feature suite (Testutil harness)
-#   run_omni_smoke      — the vendored omni runner's own failure paths
-#   run_struct_corpus   — the shared voxgig/struct JSON corpus
-#   run_primary_corpus  — the shared primary-utility JSON corpus
+# (ocamlc) — no opam packages, no dune. The test executables:
+#   run_sdk_test         — the SDK pipeline + feature suite (Testutil harness)
+#   run_omni_smoke       — the vendored omni runner's own failure paths
+#   run_struct_corpus    — the shared voxgig/struct JSON corpus
+#   run_primary_corpus   — the shared primary-utility JSON corpus
+#   run_concurrency_test — requests on several threads at once on one client
 #
 # The two corpus suites run on the VENDORED @voxgig/omni engine
 # (test/vendor/omni/omni.ml), driven through its native API by the local
@@ -95,6 +96,11 @@ CLEAN_TESTS = $(sort $(wildcard test/clean_test.ml))
 # Wildcard so an absent file is simply skipped, never a missing-target error.
 DOC_TESTS = $(sort $(wildcard test/readme_examples_test.ml))
 
+# Requests on several threads at once on one client. Only this executable
+# links the threads library; the SDK itself never does.
+CONCURRENCY_SRC = $(RUNTIME) sdk_config.ml $(ENTITIES) sdk_client.ml sdk_error.ml \
+  test/testutil.ml test/concurrency_test.ml
+
 # Fixed test order: harness deps first, generated/behaviour tests, the gated
 # feature suites, summary last.
 SDK_TEST = $(RUNTIME) sdk_config.ml $(ENTITIES) sdk_client.ml sdk_error.ml \
@@ -117,9 +123,9 @@ PRIMARY_SRC = $(RUNTIME) sdk_config.ml $(ENTITIES) sdk_client.ml sdk_error.ml \
 SMOKE_SRC = utility/vregex.ml utility/voxgig_struct.ml \
   $(OMNI) test/omni_smoke_test.ml
 
-.PHONY: test test-sdk test-omni test-corpus test-primary build lint clean
+.PHONY: test test-sdk test-omni test-corpus test-primary test-concurrency build lint clean
 
-test: test-sdk test-omni test-corpus test-primary
+test: test-sdk test-omni test-corpus test-primary test-concurrency
 
 test-sdk: run_sdk_test
 	./run_sdk_test
@@ -133,6 +139,9 @@ test-corpus: run_struct_corpus
 test-primary: run_primary_corpus
 	./run_primary_corpus $(CORPUS)
 
+test-concurrency: run_concurrency_test
+	./run_concurrency_test
+
 # Every executable that links the RUNTIME links the gated feature tier with
 # it: library archives FIRST (an archive must precede the modules that use
 # it), stub objects and link flags LAST.
@@ -148,6 +157,10 @@ run_struct_corpus: $(CORPUS_SRC)
 run_primary_corpus: $(PRIMARY_SRC) $(FEATURE_OBJ)
 	$(OCAMLC) $(INC) $(FEATURE_LIB) $(PRIMARY_SRC) $(FEATURE_OBJ) $(FEATURE_LINK) -o run_primary_corpus
 
+run_concurrency_test: $(CONCURRENCY_SRC) $(FEATURE_OBJ)
+	$(OCAMLC) $(INC) -I +unix -I +threads unix.cma threads.cma $(filter-out unix.cma,$(FEATURE_LIB)) \
+	  $(CONCURRENCY_SRC) $(FEATURE_OBJ) $(FEATURE_LINK) -o run_concurrency_test
+
 # Type-check the SDK library (a clean compile means it is sound).
 build: lint
 lint:
@@ -159,4 +172,4 @@ clean:
 	  test/vendor/omni/*.cmi test/vendor/omni/*.cmo \
 	  feature/*.cmi feature/*.cmo feature/*/*/*.cmi feature/*/*/*.cmo \
 	  feature/*/*/*.o test/feature/*/*.cmi test/feature/*/*.cmo \
-	  run_sdk_test run_omni_smoke run_struct_corpus run_primary_corpus a.out
+	  run_sdk_test run_omni_smoke run_struct_corpus run_primary_corpus run_concurrency_test a.out

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

@@ -477,6 +477,8 @@ let validate_feature () : feature =
      * and under `strict` every custom-action call would be rejected for the
      * one key that made it reachable. *)
     ignore (delprop out (Str "$action"));
+    (* Nor is `$body`, the raw request body. *)
+    ignore (delprop out (Str "$body"));
     out in
 
   (* One validate call. Errors are COLLECTED, never raised: validate raises on
@@ -1468,16 +1470,37 @@ let netsim_feature () : feature =
 let test_feature () : feature =
   let f = { f_name = "test"; f_version = "0.0.1"; f_active = true; f_options = Noval;
             f_init = (fun _ _ -> ()); f_hook = (fun _ _ -> ()) } in
+  (* The key a list's response transform
+     ["`$EACH`", "body", {"`$MERGE`": "`.<key>`"}] reads each item's record
+     under. *)
+  let item_envelope_key restf =
+    match restf with
+    | List r ->
+      (match !r with
+       | [Str "`$EACH`"; Str "body"; merge] ->
+         (match getp merge "`$MERGE`" with
+          | Str m ->
+            let n = String.length m in
+            if n >= 4 && String.sub m 0 2 = "`." && m.[n - 1] = '`' then
+              let key = String.sub m 2 (n - 3) in
+              if String.contains key '.' || String.contains key '`' || String.contains key '$'
+              then None else Some key
+            else None
+          | _ -> None)
+       | _ -> None)
+    | _ -> None in
   (* THE MOCK HAS TO AGREE WITH THE MODEL. A point carrying
      `transform.res: `body.item`` describes an API that answers {"item": {...}}
      and the response transform unwraps that key on the way back. Returning the
      bare payload means the transform unwraps a property that is not there and
      the caller gets nothing. Mirrors the go/ts/lua/php mocks. *)
   let envelope ctx data =
+    let restf = getp (getp ctx.c_point "transform") "res" in
     if is_nullish data then data
     else
-      match getp (getp ctx.c_point "transform") "res" with
-      | Str spec ->
+      match item_envelope_key restf, restf, data with
+      | Some key, _, List items -> ja (List.map (fun item -> jo [(key, item)]) !items)
+      | _, Str spec, _ ->
         let n = String.length spec in
         (* Rebuild whatever nesting the transform unwraps. Multi-segment on
            purpose: GraphQL ops unwrap `body.data.<field>`. *)
@@ -1568,7 +1591,7 @@ let test_feature () : feature =
            (match found with List r -> List.iter (fun item -> ignore (delprop item (Str "$KEY"))) !r | _ -> ());
            respond fctx 200 (clone found) None
          end
-       | "update" ->
+       | "update" | "patch" ->
          let update_match = empty_map () in
          (match fctx.c_reqdata with
           | Map _ ->
@@ -1583,7 +1606,13 @@ let test_feature () : feature =
          (* update miss: 404, never another record *)
          if is_nullish ent then respond fctx 404 Noval (Some (jo [("statusText", Str "Not found")]))
          else begin
-           (match ent, fctx.c_reqdata with Map _, Map _ -> ignore (merge (ja [ent; fctx.c_reqdata])) | _ -> ());
+           (* `$body` travels on the wire alone; the record is the rest. *)
+           (match ent, fctx.c_reqdata with
+            | Map _, Map _ ->
+              let rest = clone fctx.c_reqdata in
+              ignore (delprop rest (Str "$body"));
+              ignore (merge (ja [ent; rest]))
+            | _ -> ());
            ignore (delprop ent (Str "$KEY"));
            respond fctx 200 (clone ent) None
          end
@@ -1598,6 +1627,7 @@ let test_feature () : feature =
          let ent = clone fctx.c_reqdata in
          (match ent with
           | Map _ ->
+            ignore (delprop ent (Str "$body"));
             setp ent "id" eid;
             (match eid with Str s -> setp entmap s ent | _ -> ());
             ignore (delprop ent (Str "$KEY"));
@@ -1686,7 +1716,13 @@ let prepare (client : sdk_client) (fetchargs : value) : value =
   let ctx = u.u_make_context { (default_ctxspec ()) with cs_opname = Some "prepare"; cs_ctrl = Some ctrl } client.cl_rootctx in
   let options = client.cl_options in
   let path = match getp fetchargs "path" with Str s -> s | _ -> "" in
-  let method_ = match getp fetchargs "method" with Str s -> s | _ -> "GET" in
+  let method_ = String.uppercase_ascii
+      (match getp fetchargs "method" with Str s when s <> "" -> s | _ -> "GET") in
+  let allow_method = getpath_s options "allow.method" in
+  if not (allow_list_has allow_method method_) then
+    raise (Sdk_error_exc (ctx_make_error ctx "spec_method_allow"
+      ("Method \"" ^ method_ ^ "\" not allowed by SDK option allow.method value: \"" ^
+       (match allow_method with Str s -> s | _ -> "") ^ "\"")));
   let params = match to_map (getp fetchargs "params") with Map _ as m -> m | _ -> empty_map () in
   let query = match to_map (getp fetchargs "query") with Map _ as m -> m | _ -> empty_map () in
   let headers = u.u_prepare_headers ctx in
@@ -1704,9 +1740,7 @@ let prepare (client : sdk_client) (fetchargs : value) : value =
 
 (* Is this raw-access op permitted by the SDK's allow.op option? *)
 let op_allowed (client : sdk_client) (op : string) : bool =
-  match getpath_s client.cl_options "allow.op" with
-  | Str allow -> substr_contains allow op
-  | _ -> false
+  allow_list_has (getpath_s client.cl_options "allow.op") op
 
 let op_denied (client : sdk_client) (op : string) : value =
   let allow = match getpath_s client.cl_options "allow.op" with
@@ -1742,8 +1776,20 @@ let raw_request (client : sdk_client) (fetchargs : value) : value =
            let no_body = status = 204 || status = 304 || content_length = "0" in
            let json_data = if no_body then Noval
              else (match getp fetched "json" with Func _ as jf -> (try call_json jf with _ -> Noval) | _ -> Noval) in
-           jo [("ok", Bool (status >= 200 && status < 300)); ("status", vint_of status);
-               ("headers", headers); ("data", json_data)]
+           let body_err =
+             if not no_body && getp fetched "unreadable" = Bool true then begin
+               let failed = if status >= 200 && status < 300 then None
+                 else Some (ctx_make_error ctx "request_status"
+                              ("request: " ^ string_of_int status ^ ": " ^ vstring (getp fetched "statusText"))) in
+               Some (unreadable_body ctx status headers (getp fetched "body") (getp fetchdef "headers") failed)
+             end else None in
+           (match body_err with
+            | Some e ->
+              jo [("ok", Bool false); ("status", vint_of status); ("headers", headers);
+                  ("data", json_data); ("err", u.u_clean ctx (err_to_value e))]
+            | None ->
+              jo [("ok", Bool (status >= 200 && status < 300)); ("status", vint_of status);
+                  ("headers", headers); ("data", json_data)])
          | _ -> jo [("ok", Bool false); ("err", err_to_value (ctx_make_error ctx "direct_invalid" "invalid response type"))]))
 
 (* Raw endpoint access is operator-controllable, like every entity op.

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

@@ -150,3 +150,12 @@ let num_opt (v : value) : float option =
 
 let int_opt (v : value) : int option =
   match v with Num n -> Some (int_of_float n) | _ -> None
+
+(* The caller's cookie pieces with the named cookies removed: a cookie is one
+ * ;-delimited piece, whatever its value holds. *)
+let cookie_keep (header : string) (names : string list) : string list =
+  List.filter_map (fun piece ->
+      let cookie = String.trim piece in
+      let name = String.trim (List.hd (String.split_on_char '=' cookie)) in
+      if cookie = "" || List.mem name names then None else Some cookie)
+    (String.split_on_char ';' header)