@voxgig/sdkgen 1.3.8 → 1.3.10

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

@@ -0,0 +1,259 @@
+(* ProjectName SDK core types.
+ *
+ * The SDK data model is the vendored voxgig struct `value` type
+ * (utility/voxgig_struct.ml): a JSON-shaped, reference-stable node used for
+ * ctx data, specs, options, transport payloads and results — exactly as the
+ * Python/Go SDKs pass map[string]any around.
+ *
+ * OCaml is functional, but the operation pipeline is inherently a
+ * shared-mutable state machine (feature hooks observe and mutate the context
+ * across stages, transport wrappers re-bind the fetcher). So the pipeline
+ * objects — context, control, spec, response, result, operation, the utility
+ * bundle, features and entities — are modelled as mutable records, and the
+ * feature/utility indirection that the dynamic donors get from late binding
+ * is reproduced here with closure-valued record fields (the `utility`
+ * registrar pattern). Everything is defined in one mutually-recursive block
+ * so context <-> utility <-> feature <-> entity can reference each other. *)
+
+open Voxgig_struct
+
+(* Branded SDK error. Raised as `Sdk_error_exc` on the throwing path; carried
+ * as `sdk_error option` on the (value, err) pipeline return tuples. *)
+type sdk_error = {
+  mutable err_code : string;
+  mutable err_msg : string;
+  mutable err_result : value;
+  mutable err_spec : value;
+}
+
+exception Sdk_error_exc of sdk_error
+
+(* A pipeline stage stashes its product (or a feature-supplied short-circuit
+ * error) on ctx.out under the stage name (mirrors the py ctx.out dict). *)
+type out_entry =
+  | OErr of sdk_error
+  | OPoint of value
+  | OSpec of spec
+  | OResponse of response
+  | OResult of result
+
+(* Per-call control state (throw policy, error, explain trace, actor, paging). *)
+and control = {
+  mutable ctrl_throw : bool option;
+  mutable ctrl_err : sdk_error option;
+  mutable ctrl_explain : value;   (* Map when explain is on, else Noval *)
+  mutable ctrl_actor : value;     (* Str or Noval *)
+  mutable ctrl_paging : value;    (* Map or Noval *)
+}
+
+and operation = {
+  mutable op_entity : string;
+  mutable op_name : string;
+  mutable op_input : string;
+  mutable op_points : value;      (* List *)
+  mutable op_alias : value;       (* Map or Noval *)
+}
+
+and spec = {
+  mutable sp_parts : value;
+  mutable sp_headers : value;     (* Map *)
+  mutable sp_alias : value;       (* Map *)
+  mutable sp_base : string;
+  mutable sp_prefix : string;
+  mutable sp_suffix : string;
+  mutable sp_params : value;      (* Map *)
+  mutable sp_query : value;       (* Map *)
+  mutable sp_step : string;
+  mutable sp_method : string;
+  mutable sp_body : value;
+  mutable sp_url : string;
+  mutable sp_path : string;
+}
+
+and response = {
+  mutable rs_status : int;
+  mutable rs_status_text : string;
+  mutable rs_headers : value;
+  mutable rs_json : value;        (* Func thunk or Noval *)
+  mutable rs_body : value;
+  mutable rs_err : sdk_error option;
+}
+
+and result = {
+  mutable rt_ok : bool;
+  mutable rt_status : int;
+  mutable rt_status_text : string;
+  mutable rt_headers : value;     (* Map *)
+  mutable rt_body : value;
+  mutable rt_err : sdk_error option;
+  mutable rt_resdata : value;
+  mutable rt_resmatch : value;    (* Map or Noval *)
+  mutable rt_paging : value;      (* paging feature *)
+  mutable rt_streaming : bool;    (* streaming feature *)
+  mutable rt_stream : (unit -> value list) option;
+}
+
+(* A lean view of the vendored struct, exposed on utility.struct as required
+ * so consumers reach the same data utilities the pipeline is built on. *)
+and struct_api = {
+  s_getprop : value -> value -> value;
+  s_setprop : value -> value -> value -> value;
+  s_getpath : value -> value -> value;
+  s_setpath : value -> value -> value -> value;
+  s_getelem : value -> value -> value;
+  s_haskey : value -> value -> bool;
+  s_clone : value -> value;
+  s_merge : value list -> value;
+  s_items : value -> value;
+  s_keysof : value -> string list;
+  s_size : value -> int;
+  s_isempty : value -> bool;
+  s_isnode : value -> bool;
+  s_ismap : value -> bool;
+  s_islist : value -> bool;
+  s_stringify : value -> string;
+  s_jsonify : value -> string;
+  s_escurl : value -> string;
+  s_escre : value -> string;
+  s_transform : value -> value -> value;
+  s_validate : value -> value -> value;
+  s_select : value -> value -> value;
+}
+
+(* The utility bundle. `fetcher` (transport) and `custom` (caller utilities)
+ * vary per client; the rest are wired once by Sdk_runtime.register. Every
+ * function is a closure-valued field so utilities/features can reference each
+ * other through the record without an OCaml module cycle. The (value, err)
+ * tuple return mirrors the py utilities. *)
+and utility = {
+  mutable u_custom : value;       (* Map of custom callables *)
+  mutable u_struct : struct_api;
+  mutable u_fetcher : ctx -> string -> value -> (value * sdk_error option);
+  mutable u_clean : ctx -> value -> value;
+  mutable u_done : ctx -> value;
+  mutable u_make_error : ctx -> sdk_error option -> value;
+  mutable u_feature_add : ctx -> feature -> unit;
+  mutable u_feature_hook : ctx -> string -> unit;
+  mutable u_feature_init : ctx -> feature -> unit;
+  mutable u_make_fetch_def : ctx -> (value * sdk_error option);
+  mutable u_make_context : ctxspec -> ctx option -> ctx;
+  mutable u_make_options : ctx -> value;
+  mutable u_make_request : ctx -> (response option * sdk_error option);
+  mutable u_make_response : ctx -> (response option * sdk_error option);
+  mutable u_make_result : ctx -> (result option * sdk_error option);
+  mutable u_make_point : ctx -> (value * sdk_error option);
+  mutable u_make_spec : ctx -> (spec option * sdk_error option);
+  mutable u_make_url : ctx -> (string * sdk_error option);
+  mutable u_param : ctx -> value -> value;
+  mutable u_prepare_auth : ctx -> (spec option * sdk_error option);
+  mutable u_prepare_body : ctx -> value;
+  mutable u_prepare_headers : ctx -> value;
+  mutable u_prepare_method : ctx -> string;
+  mutable u_prepare_params : ctx -> value;
+  mutable u_prepare_path : ctx -> string;
+  mutable u_prepare_query : ctx -> value;
+  mutable u_result_basic : ctx -> unit;
+  mutable u_result_body : ctx -> unit;
+  mutable u_result_headers : ctx -> unit;
+  mutable u_transform_request : ctx -> value;
+  mutable u_transform_response : ctx -> value;
+}
+
+(* A pipeline feature: name/version/active bookkeeping, the `f_options`
+ * ordering carrier consulted by feature_add (__before__/__after__/__replace__),
+ * an `init` and a name-keyed hook dispatch (the dynamic getattr(f,name) of the
+ * py port, expressed as a closure that pattern-matches the hook name). *)
+and feature = {
+  mutable f_name : string;
+  mutable f_version : string;
+  mutable f_active : bool;
+  mutable f_options : value;      (* ordering carrier; Map or Noval *)
+  mutable f_init : ctx -> value -> unit;
+  mutable f_hook : string -> ctx -> unit;
+}
+
+and sdk_client = {
+  mutable cl_mode : string;
+  mutable cl_features : feature list;
+  mutable cl_options : value;
+  mutable cl_utility : utility;
+  mutable cl_rootctx : ctx option;
+  (* Feature tracking sink (py's dynamic client._retry / _cache / ...): a
+   * struct Map keyed by feature name. Reference-stable so a feature can grab
+   * its bucket once and keep mutating it. *)
+  mutable cl_track : value;
+}
+
+and entity_obj = {
+  mutable e_name : string;
+  mutable e_client : sdk_client;
+  mutable e_utility : utility;
+  mutable e_entopts : value;
+  mutable e_data : value;
+  mutable e_match : value;
+  mutable e_entctx : ctx;
+  mutable e_make : unit -> entity_obj;
+  mutable e_data_set : value -> unit;
+  mutable e_data_get : unit -> value;
+  mutable e_match_set : value -> unit;
+  mutable e_match_get : unit -> value;
+  mutable e_load : value -> value -> value;
+  mutable e_list : value -> value -> value;
+  mutable e_create : value -> value -> value;
+  mutable e_update : value -> value -> value;
+  mutable e_remove : value -> value -> value;
+  (* stream action args callopts -> a lazy Seq over result items. *)
+  mutable e_stream : string -> value -> value -> value Seq.t;
+}
+
+(* Construction spec for a context (py passes an untyped ctxmap dict that
+ * mixes struct data with live objects; OCaml uses this typed optional-field
+ * builder, mirroring the rust CtxSpec). *)
+and ctxspec = {
+  mutable cs_opname : string option;
+  mutable cs_client : sdk_client option;
+  mutable cs_utility : utility option;
+  mutable cs_ctrl : value option;       (* ctrl as a {throw,explain,actor,paging} map *)
+  mutable cs_meta : value option;
+  mutable cs_config : value option;
+  mutable cs_entopts : value option;
+  mutable cs_options : value option;
+  mutable cs_entity : entity_obj option;
+  mutable cs_shared : value option;
+  mutable cs_opmap : (string, operation) Hashtbl.t option;
+  mutable cs_data : value option;
+  mutable cs_reqdata : value option;
+  mutable cs_match : value option;
+  mutable cs_reqmatch : value option;
+  mutable cs_point : value option;
+  mutable cs_spec : spec option;
+  mutable cs_result : result option;
+  mutable cs_response : response option;
+}
+
+and ctx = {
+  mutable c_id : string;
+  mutable c_out : (string, out_entry) Hashtbl.t;
+  mutable c_ctrl : control;
+  mutable c_meta : value;
+  mutable c_client : sdk_client option;
+  mutable c_utility : utility option;
+  mutable c_op : operation;
+  mutable c_point : value;        (* Map or Noval *)
+  mutable c_config : value;
+  mutable c_entopts : value;
+  mutable c_options : value;
+  mutable c_opmap : (string, operation) Hashtbl.t;
+  mutable c_response : response option;
+  mutable c_result : result option;
+  mutable c_spec : spec option;
+  mutable c_data : value;
+  mutable c_reqdata : value;
+  mutable c_match : value;
+  mutable c_reqmatch : value;
+  mutable c_entity : entity_obj option;
+  mutable c_shared : value;
+  (* per-op feature scratch (telemetry span, metrics start, debug entry,
+   * audit-seen flag): keyed by feature, holding a struct value. *)
+  mutable c_scratch : (string, value) Hashtbl.t;
+}

package/project/.sdk/tm/ocaml/src/feature/README.md

@@ -0,0 +1 @@
+# ocaml feature src dirs (srcfeature:false — flat feature/ files)

package/project/.sdk/tm/ocaml/test/custom_utility.ml

@@ -0,0 +1,30 @@
+(* Custom utility overrides (mirrors tm/rust custom_utility_test): caller-
+ * supplied callables in options.utility land on utility.custom, reachable via
+ * the client's utility bundle. *)
+
+open Voxgig_struct
+open Sdk_types
+open Sdk_helpers
+open Testutil
+
+let utils = [
+  ("auth", "AUTH"); ("body", "BODY"); ("contextify", "CONTEXTIFY"); ("done", "DONE");
+  ("error", "ERROR"); ("findparam", "FINDPARAM"); ("fullurl", "FULLURL"); ("headers", "HEADERS");
+  ("method", "METHOD"); ("operator", "OPERATOR"); ("params", "PARAMS"); ("query", "QUERY");
+  ("reqform", "REQFORM"); ("request", "REQUEST"); ("resbasic", "RESBASIC"); ("resbody", "RESBODY");
+  ("resform", "RESFORM"); ("resheaders", "RESHEADERS"); ("response", "RESPONSE"); ("result", "RESULT");
+  ("spec", "SPEC") ]
+
+let () =
+  test "custom_utility.basic" (fun () ->
+      let utility_opts = empty_map () in
+      List.iter (fun (key, tag) ->
+          setp utility_opts key (vfunc1 (fun _ -> jo [("util", Str tag)]))) utils;
+      let client =
+        Sdk_client.test_with Noval (jo [("apikey", Str "APIKEY01"); ("utility", utility_opts)]) in
+      let u = client.cl_utility in
+      List.iter (fun (key, tag) ->
+          let f = getp u.u_custom key in
+          check (key ^ " exists") (is_callable f);
+          let out = call_vfn f Noval in
+          check_vstr (key ^ " tag") (getp out "util") tag) utils)

package/project/.sdk/tm/ocaml/test/harness.ml

@@ -0,0 +1,198 @@
+(* Offline feature-test harness (mirrors the py feature_harness).
+ *
+ * Drives each real generated feature class through a faithful miniature of
+ * the operation pipeline against a configurable mock transport — the same
+ * hook order and short-circuit rules as the generated op runner, but with no
+ * live server and no API-specific fixtures. Feature instances come from the
+ * generated Sdk_config.make_feature, so only features present in this SDK are
+ * exercised (see has_feature). *)
+
+open Voxgig_struct
+open Sdk_types
+open Sdk_helpers
+open Sdk_runtime
+
+(* ----- deterministic virtual clock ----- *)
+type clock = { mutable t : float }
+let make_clock ?(start = 0.) () : clock = { t = start }
+let clock_now (c : clock) : float = c.t
+let clock_sleep (c : clock) (ms : float) : unit = c.t <- c.t +. (if ms < 0. then 0. else ms)
+let clock_advance (c : clock) (ms : float) : unit = c.t <- c.t +. ms
+let clock_now_fn (c : clock) : value = vfunc0 (fun () -> Num c.t)
+let clock_sleep_fn (c : clock) : value = vfunc1 (fun v -> (match v with Num ms -> clock_sleep c ms | _ -> ()); Noval)
+
+(* ----- transport-shaped response ----- *)
+let make_response ?(headers = []) (status : int) (data : value) : value =
+  let lower = empty_map () in
+  List.iter (fun (k, v) -> setp lower (String.lowercase_ascii k) v) headers;
+  jo [("status", vint_of status);
+      ("statusText", Str (if status < 400 then "OK" else "ERR"));
+      ("body", Str "not-used"); ("json", json_thunk data); ("headers", lower)]
+
+type server = ctx -> string -> value -> (value * sdk_error option)
+
+let default_server () : server =
+  fun _ctx _url fetchdef ->
+    let meth = match getp fetchdef "method" with Str s -> String.uppercase_ascii s | _ -> "GET" in
+    if meth = "GET" then (make_response 200 (jo [("ok", Bool true); ("method", Str meth)]), None)
+    else (make_response 200 (jo [("ok", Bool true); ("method", Str meth); ("echo", getp fetchdef "body")]), None)
+
+(* reply : call-number -> fetchdef -> (response, err) *)
+let recording_server ?(reply : (int -> value -> (value * sdk_error option)) option) () : server * value list ref =
+  let calls = ref [] in
+  let srv ctx url fetchdef =
+    ignore ctx;
+    calls := !calls @ [jo [("url", Str url); ("fetchdef", fetchdef)]];
+    match reply with
+    | Some r -> r (List.length !calls) fetchdef
+    | None -> (make_response 200 (jo [("ok", Bool true); ("n", vint_of (List.length !calls))]), None)
+  in
+  (srv, calls)
+
+(* ----- SDK feature presence ----- *)
+let has_feature (name : string) : bool =
+  match getp (Sdk_config.make_config ()) "feature" with
+  | Map _ as fm -> not (is_nullish (getp fm name))
+  | _ -> false
+
+(* ----- op result ----- *)
+type op_result = {
+  or_ok : bool;
+  or_data : value;
+  or_result : result option;
+  or_ctx : ctx;
+  or_error : sdk_error option;
+  or_response : value;
+}
+
+type harness = {
+  h_base : string;
+  h_headers : value;
+  h_client : sdk_client;
+  h_utility : utility;
+  h_rootctx : ctx;
+}
+
+let make_client ?(server : server option) ?(mode = "test") ?(base = "http://api.test")
+    ?(headers : (string * value) list = []) (features : (string * value) list) : harness =
+  let hheaders = empty_map () in
+  List.iter (fun (k, v) -> setp hheaders k v) headers;
+  let srv = match server with Some s -> s | None -> default_server () in
+  let utility = new_utility () in
+  register utility;
+  utility.u_fetcher <- srv;
+  utility.u_param <- (fun ctx name ->
+      let key = match name with Str s -> s | _ -> "" in
+      match ctx.c_spec with
+      | Some sp -> let v = getp sp.sp_params key in if not (is_noval v) then v else getp sp.sp_query key
+      | None -> Noval);
+  let client = { cl_mode = mode; cl_features = [];
+                 cl_options = jo [("base", Str base); ("headers", clone hheaders); ("feature", empty_map ())];
+                 cl_utility = utility; cl_rootctx = None; cl_track = empty_map () } in
+  let rootctx = make_context_impl { (default_ctxspec ()) with cs_client = Some client; cs_utility = Some utility } None in
+  rootctx.c_op <- new_operation (jo [("name", Str "root"); ("entity", Str "_")]);
+  client.cl_rootctx <- Some rootctx;
+  List.iter (fun (name, opts) ->
+      if has_feature name then begin
+        let ftr = Sdk_config.make_feature name in
+        let fopts = jo [("active", Bool true)] in
+        (match opts with Map _ -> List.iter (fun k -> setp fopts k (getp opts k)) (keysof opts) | _ -> ());
+        setp (getp client.cl_options "feature") name fopts;
+        ftr.f_init rootctx fopts;
+        client.cl_features <- client.cl_features @ [ftr]
+      end) features;
+  feature_hook_util rootctx "PostConstruct";
+  { h_base = base; h_headers = hheaders; h_client = client; h_utility = utility; h_rootctx = rootctx }
+
+let feature (h : harness) (name : string) : feature option =
+  List.find_opt (fun f -> f.f_name = name) h.h_client.cl_features
+
+let default_method op = match op with "create" -> "POST" | "update" -> "PATCH" | "remove" -> "DELETE" | _ -> "GET"
+
+let build_url (sp : spec) : string =
+  let q = match sp.sp_query with Map _ as m -> m | _ -> empty_map () in
+  let keys = List.filter (fun k -> not (is_noval (getp q k))) (List.sort compare (keysof q)) in
+  let esc s = match escurl (Str s) with Str x -> x | _ -> s in
+  let qs = String.concat "&" (List.map (fun k -> esc k ^ "=" ^ esc (match getp q k with Str s -> s | Noval | Null -> "" | v -> js_string v)) keys) in
+  sp.sp_base ^ sp.sp_path ^ (if qs <> "" then "?" ^ qs else "")
+
+let populate_result (ctx : ctx) (response : value) (fetch_err : sdk_error option) : unit =
+  let result = new_result (empty_map ()) in
+  ctx.c_result <- Some result;
+  (match fetch_err with
+   | Some e -> result.rt_err <- Some e
+   | None ->
+     if is_noval response || response = Null then
+       result.rt_err <- Some (ctx_make_error ctx "request_no_response" "response: undefined")
+     else match response with
+       | Map _ ->
+         result.rt_status <- to_int (getp response "status");
+         result.rt_status_text <- (match getp response "statusText" with Str s -> s | _ -> "");
+         result.rt_headers <- (match getp response "headers" with Map _ as m -> clone m | _ -> empty_map ());
+         (match getp response "json" with Func _ as fn -> (try result.rt_body <- call_json fn with _ -> ()) | _ -> ());
+         result.rt_resdata <- result.rt_body;
+         (if result.rt_status >= 400 then
+            result.rt_err <- Some (ctx_make_error ctx "request_status"
+              ("request: " ^ string_of_int result.rt_status ^ ": " ^ result.rt_status_text)));
+         if result.rt_err = None then result.rt_ok <- true
+       | _ -> result.rt_err <- Some (ctx_make_error ctx "op_failed" "invalid response"))
+
+let op (h : harness) ?(op = "load") ?(entity = "widget") ?(method_ : string option)
+    ?(path : string option) ?(query : value option) ?(headers : (string * value) list option)
+    ?(body = Noval) ?(ctrl = Noval) () : op_result =
+  let opname = op in
+  let meth = match method_ with Some m -> m | None -> default_method opname in
+  let ctrl_map = match ctrl with Map _ as m -> m | _ -> empty_map () in
+  let ctx = make_context_impl
+      { (default_ctxspec ()) with cs_client = Some h.h_client; cs_utility = Some h.h_utility; cs_ctrl = Some ctrl_map }
+      (Some h.h_rootctx) in
+  ctx.c_op <- new_operation (jo [("name", Str opname); ("entity", Str entity)]);
+  feature_hook_util ctx "PostConstructEntity";
+  let finish_err (err : sdk_error) =
+    ctx.c_ctrl.ctrl_err <- Some err;
+    feature_hook_util ctx "PreUnexpected";
+    { or_ok = false; or_error = Some err; or_result = ctx.c_result; or_ctx = ctx; or_data = Noval; or_response = Noval }
+  in
+  try
+    feature_hook_util ctx "PrePoint";
+    (match Hashtbl.find_opt ctx.c_out "point" with Some (OErr e) -> raise (Sdk_error_exc e) | _ -> ());
+    feature_hook_util ctx "PreSpec";
+    let spec =
+      match Hashtbl.find_opt ctx.c_out "spec" with
+      | Some (OSpec s) -> s
+      | _ ->
+        let merged = match clone h.h_headers with Map _ as m -> m | _ -> empty_map () in
+        (match headers with Some hs -> List.iter (fun (k, v) -> setp merged k v) hs | None -> ());
+        new_spec (jo [("method", Str meth); ("base", Str h.h_base);
+                      ("path", Str (match path with Some p -> p | None -> "/" ^ entity));
+                      ("params", empty_map ()); ("headers", merged);
+                      ("query", (match query with Some q -> q | None -> empty_map ()));
+                      ("body", body); ("step", Str "start")])
+    in
+    ctx.c_spec <- Some spec;
+    feature_hook_util ctx "PreRequest";
+    spec.sp_url <- build_url spec;
+    let response = ref Noval and fetch_err = ref None in
+    (match Hashtbl.find_opt ctx.c_out "request" with
+     | Some (OResponse _) -> ()
+     | _ ->
+       let fetchdef = jo [("url", Str spec.sp_url); ("method", Str spec.sp_method);
+                          ("headers", spec.sp_headers); ("body", spec.sp_body)] in
+       let (f, e) = (cu ctx).u_fetcher ctx spec.sp_url fetchdef in
+       response := f; fetch_err := e);
+    let resp_val = !response in
+    feature_hook_util ctx "PreResponse";
+    populate_result ctx !response !fetch_err;
+    feature_hook_util ctx "PreResult";
+    feature_hook_util ctx "PreDone";
+    (match ctx.c_result with
+     | Some r when r.rt_ok ->
+       { or_ok = true; or_data = r.rt_resdata; or_result = Some r; or_ctx = ctx; or_error = None; or_response = resp_val }
+     | _ ->
+       let err = match ctx.c_result with
+         | Some r -> (match r.rt_err with Some e -> e | None -> ctx_make_error ctx "op_failed" "operation failed")
+         | None -> ctx_make_error ctx "op_failed" "operation failed" in
+       raise (Sdk_error_exc err))
+  with
+  | Sdk_error_exc err -> finish_err err
+  | e -> finish_err (ctx_make_error ctx "op_failed" (Printexc.to_string e))