T8061: add get_path_type request

Get the potential node type of a path, preliminary to any validation of
values.

8 files changed, 124 insertions, 1 deletions

diff --git a/src/session.ml b/src/session.ml
index c869a1a..f924591 100644
--- a/src/session.ml
+++ b/src/session.ml
@@ -394,6 +394,9 @@ let config_unsaved w s file id =
 let reference_path_exists w _s path =
     RT.reference_path_exists w.reference_tree path
 
+let get_path_type ?(legacy_format=false) w _s path =
+    RT.get_path_type_str ~legacy_format w.reference_tree path
+
 let write_running_cache w =
     (* alert exn Internal.write_internal:
         [Internal.Write_error] caught
diff --git a/src/session.mli b/src/session.mli
index 20e0c52..5209878 100644
--- a/src/session.mli
+++ b/src/session.mli
@@ -96,3 +96,5 @@ val cleanup_config : world -> string -> unit
 val show_config : world -> session_data -> string list -> string
 
 val reference_path_exists : world -> session_data -> string list -> bool
+
+val get_path_type : ?legacy_format:bool -> world -> session_data -> string list -> string
diff --git a/src/vyconf_cli_compat.ml b/src/vyconf_cli_compat.ml
index ae0d378..c86ca2c 100644
--- a/src/vyconf_cli_compat.ml
+++ b/src/vyconf_cli_compat.ml
@@ -11,6 +11,7 @@ type op_t =
     | OpSessionChanged
     | OpConfigUnsaved
     | OpReferencePathExists
+    | OpGetPathType
 
 let op_of_arg s =
     match s with
@@ -23,6 +24,7 @@ let op_of_arg s =
     | "sessionChanged" -> OpSessionChanged
     | "sessionUnsaved" -> OpConfigUnsaved
     | "validateTmplPath" -> OpReferencePathExists
+    | "getNodeType" -> OpGetPathType
     | _ -> failwith (Printf.sprintf "Unknown operation %s" s)
 
 let in_cli_config_session () =
@@ -94,6 +96,7 @@ let main op path =
         | OpSessionChanged -> session_changed c
         | OpConfigUnsaved -> config_unsaved c None
         | OpReferencePathExists -> reference_path_exists c path
+        | OpGetPathType -> get_path_type c path
         end
     | Error e -> Error e |> Lwt.return
     in
@@ -131,7 +134,7 @@ let () =
         with Failure msg -> let () = print_endline msg in exit 1
     in
     match op, path_list with
-    | OpSetEditLevel, [] | OpReferencePathExists, [] ->
+    | OpSetEditLevel, [] | OpReferencePathExists, [] | OpGetPathType, [] ->
         let () = print_endline "Must specify config path" in exit 1
     | _, _ ->
         let result = Lwt_main.run (main op path_list) in exit result
diff --git a/src/vyconf_client.ml b/src/vyconf_client.ml
index 20899fe..8a8dc46 100644
--- a/src/vyconf_client.ml
+++ b/src/vyconf_client.ml
@@ -237,3 +237,11 @@ let reference_path_exists client path =
     | Success -> Lwt.return (Ok "")
     | Fail -> Error (Option.value resp.error ~default:"") |> Lwt.return
     | _ -> Error (Option.value resp.error ~default:"") |> Lwt.return
+
+let get_path_type client path =
+    let req = Get_path_type {path=path; legacy_format=true;} in
+    let%lwt resp = do_request client req in
+    match resp.status with
+    | Success -> unwrap resp.output |> Lwt.return
+    | Fail -> Error (Option.value resp.error ~default:"") |> Lwt.return
+    | _ -> Error (Option.value resp.error ~default:"") |> Lwt.return
diff --git a/src/vyconf_client.mli b/src/vyconf_client.mli
index 7fe2dd8..fabbbed 100644
--- a/src/vyconf_client.mli
+++ b/src/vyconf_client.mli
@@ -51,3 +51,5 @@ val edit_level_root : t -> (string, string) result Lwt.t
 val config_unsaved : t -> string option -> (string, string) result Lwt.t
 
 val reference_path_exists : t -> string list -> (string, string) result Lwt.t
+
+val get_path_type : t -> string list -> (string, string) result Lwt.t
diff --git a/src/vyconf_pbt.ml b/src/vyconf_pbt.ml
index e4b4935..9e5873f 100644
--- a/src/vyconf_pbt.ml
+++ b/src/vyconf_pbt.ml
@@ -187,6 +187,11 @@ type request_reference_path_exists = {
   path : string list;
 }
 
+type request_get_path_type = {
+  path : string list;
+  legacy_format : bool;
+}
+
 type request =
   | Prompt
   | Setup_session of request_setup_session
@@ -227,6 +232,7 @@ type request =
   | Edit_level_root of request_edit_level_root
   | Config_unsaved of request_config_unsaved
   | Reference_path_exists of request_reference_path_exists
+  | Get_path_type of request_get_path_type
 
 type request_envelope = {
   token : string option;
@@ -536,6 +542,14 @@ let rec default_request_reference_path_exists
   path;
 }
 
+let rec default_request_get_path_type 
+  ?path:((path:string list) = [])
+  ?legacy_format:((legacy_format:bool) = false)
+  () : request_get_path_type  = {
+  path;
+  legacy_format;
+}
+
 let rec default_request (): request = Prompt
 
 let rec default_request_envelope 
@@ -906,6 +920,16 @@ let default_request_reference_path_exists_mutable () : request_reference_path_ex
   path = [];
 }
 
+type request_get_path_type_mutable = {
+  mutable path : string list;
+  mutable legacy_format : bool;
+}
+
+let default_request_get_path_type_mutable () : request_get_path_type_mutable = {
+  path = [];
+  legacy_format = false;
+}
+
 type request_envelope_mutable = {
   mutable token : string option;
   mutable request : request;
@@ -1207,6 +1231,13 @@ let rec pp_request_reference_path_exists fmt (v:request_reference_path_exists) =
   in
   Pbrt.Pp.pp_brk pp_i fmt ()
 
+let rec pp_request_get_path_type fmt (v:request_get_path_type) = 
+  let pp_i fmt () =
+    Pbrt.Pp.pp_record_field ~first:true "path" (Pbrt.Pp.pp_list Pbrt.Pp.pp_string) fmt v.path;
+    Pbrt.Pp.pp_record_field ~first:false "legacy_format" Pbrt.Pp.pp_bool fmt v.legacy_format;
+  in
+  Pbrt.Pp.pp_brk pp_i fmt ()
+
 let rec pp_request fmt (v:request) =
   match v with
   | Prompt  -> Format.fprintf fmt "Prompt"
@@ -1248,6 +1279,7 @@ let rec pp_request fmt (v:request) =
   | Edit_level_root x -> Format.fprintf fmt "@[<hv2>Edit_level_root(@,%a)@]" pp_request_edit_level_root x
   | Config_unsaved x -> Format.fprintf fmt "@[<hv2>Config_unsaved(@,%a)@]" pp_request_config_unsaved x
   | Reference_path_exists x -> Format.fprintf fmt "@[<hv2>Reference_path_exists(@,%a)@]" pp_request_reference_path_exists x
+  | Get_path_type x -> Format.fprintf fmt "@[<hv2>Get_path_type(@,%a)@]" pp_request_get_path_type x
 
 let rec pp_request_envelope fmt (v:request_envelope) = 
   let pp_i fmt () =
@@ -1691,6 +1723,15 @@ let rec encode_pb_request_reference_path_exists (v:request_reference_path_exists
   ) v.path encoder;
   ()
 
+let rec encode_pb_request_get_path_type (v:request_get_path_type) encoder = 
+  Pbrt.List_util.rev_iter_with (fun x encoder -> 
+    Pbrt.Encoder.string x encoder;
+    Pbrt.Encoder.key 1 Pbrt.Bytes encoder; 
+  ) v.path encoder;
+  Pbrt.Encoder.bool v.legacy_format encoder;
+  Pbrt.Encoder.key 2 Pbrt.Varint encoder; 
+  ()
+
 let rec encode_pb_request (v:request) encoder = 
   begin match v with
   | Prompt ->
@@ -1810,6 +1851,9 @@ let rec encode_pb_request (v:request) encoder =
   | Reference_path_exists x ->
     Pbrt.Encoder.nested encode_pb_request_reference_path_exists x encoder;
     Pbrt.Encoder.key 39 Pbrt.Bytes encoder; 
+  | Get_path_type x ->
+    Pbrt.Encoder.nested encode_pb_request_get_path_type x encoder;
+    Pbrt.Encoder.key 40 Pbrt.Bytes encoder; 
   end
 
 let rec encode_pb_request_envelope (v:request_envelope) encoder = 
@@ -2769,6 +2813,33 @@ let rec decode_pb_request_reference_path_exists d =
     path = v.path;
   } : request_reference_path_exists)
 
+let rec decode_pb_request_get_path_type d =
+  let v = default_request_get_path_type_mutable () in
+  let continue__= ref true in
+  let legacy_format_is_set = ref false in
+  while !continue__ do
+    match Pbrt.Decoder.key d with
+    | None -> (
+      v.path <- List.rev v.path;
+    ); continue__ := false
+    | Some (1, Pbrt.Bytes) -> begin
+      v.path <- (Pbrt.Decoder.string d) :: v.path;
+    end
+    | Some (1, pk) -> 
+      Pbrt.Decoder.unexpected_payload "Message(request_get_path_type), field(1)" pk
+    | Some (2, Pbrt.Varint) -> begin
+      v.legacy_format <- Pbrt.Decoder.bool d; legacy_format_is_set := true;
+    end
+    | Some (2, pk) -> 
+      Pbrt.Decoder.unexpected_payload "Message(request_get_path_type), field(2)" pk
+    | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind
+  done;
+  begin if not !legacy_format_is_set then Pbrt.Decoder.missing_field "legacy_format" end;
+  ({
+    path = v.path;
+    legacy_format = v.legacy_format;
+  } : request_get_path_type)
+
 let rec decode_pb_request d = 
   let rec loop () = 
     let ret:request = match Pbrt.Decoder.key d with
@@ -2821,6 +2892,7 @@ let rec decode_pb_request d =
       | Some (37, _) -> (Edit_level_root (decode_pb_request_edit_level_root (Pbrt.Decoder.nested d)) : request) 
       | Some (38, _) -> (Config_unsaved (decode_pb_request_config_unsaved (Pbrt.Decoder.nested d)) : request) 
       | Some (39, _) -> (Reference_path_exists (decode_pb_request_reference_path_exists (Pbrt.Decoder.nested d)) : request) 
+      | Some (40, _) -> (Get_path_type (decode_pb_request_get_path_type (Pbrt.Decoder.nested d)) : request) 
       | Some (n, payload_kind) -> (
         Pbrt.Decoder.skip d payload_kind; 
         loop () 
diff --git a/src/vyconf_pbt.mli b/src/vyconf_pbt.mli
index 197d7d4..5c71016 100644
--- a/src/vyconf_pbt.mli
+++ b/src/vyconf_pbt.mli
@@ -194,6 +194,11 @@ type request_reference_path_exists = {
   path : string list;
 }
 
+type request_get_path_type = {
+  path : string list;
+  legacy_format : bool;
+}
+
 type request =
   | Prompt
   | Setup_session of request_setup_session
@@ -234,6 +239,7 @@ type request =
   | Edit_level_root of request_edit_level_root
   | Config_unsaved of request_config_unsaved
   | Reference_path_exists of request_reference_path_exists
+  | Get_path_type of request_get_path_type
 
 type request_envelope = {
   token : string option;
@@ -522,6 +528,13 @@ val default_request_reference_path_exists :
   request_reference_path_exists
 (** [default_request_reference_path_exists ()] is the default value for type [request_reference_path_exists] *)
 
+val default_request_get_path_type : 
+  ?path:string list ->
+  ?legacy_format:bool ->
+  unit ->
+  request_get_path_type
+(** [default_request_get_path_type ()] is the default value for type [request_get_path_type] *)
+
 val default_request : unit -> request
 (** [default_request ()] is the default value for type [request] *)
 
@@ -670,6 +683,9 @@ val pp_request_config_unsaved : Format.formatter -> request_config_unsaved -> un
 val pp_request_reference_path_exists : Format.formatter -> request_reference_path_exists -> unit 
 (** [pp_request_reference_path_exists v] formats v *)
 
+val pp_request_get_path_type : Format.formatter -> request_get_path_type -> unit 
+(** [pp_request_get_path_type v] formats v *)
+
 val pp_request : Format.formatter -> request -> unit 
 (** [pp_request v] formats v *)
 
@@ -808,6 +824,9 @@ val encode_pb_request_config_unsaved : request_config_unsaved -> Pbrt.Encoder.t
 val encode_pb_request_reference_path_exists : request_reference_path_exists -> Pbrt.Encoder.t -> unit
 (** [encode_pb_request_reference_path_exists v encoder] encodes [v] with the given [encoder] *)
 
+val encode_pb_request_get_path_type : request_get_path_type -> Pbrt.Encoder.t -> unit
+(** [encode_pb_request_get_path_type v encoder] encodes [v] with the given [encoder] *)
+
 val encode_pb_request : request -> Pbrt.Encoder.t -> unit
 (** [encode_pb_request v encoder] encodes [v] with the given [encoder] *)
 
@@ -946,6 +965,9 @@ val decode_pb_request_config_unsaved : Pbrt.Decoder.t -> request_config_unsaved
 val decode_pb_request_reference_path_exists : Pbrt.Decoder.t -> request_reference_path_exists
 (** [decode_pb_request_reference_path_exists decoder] decodes a [request_reference_path_exists] binary value from [decoder] *)
 
+val decode_pb_request_get_path_type : Pbrt.Decoder.t -> request_get_path_type
+(** [decode_pb_request_get_path_type decoder] decodes a [request_get_path_type] binary value from [decoder] *)
+
 val decode_pb_request : Pbrt.Decoder.t -> request
 (** [decode_pb_request decoder] decodes a [request] binary value from [decoder] *)
 
diff --git a/src/vyconfd.ml b/src/vyconfd.ml
index 95e951e..96c2e42 100644
--- a/src/vyconfd.ml
+++ b/src/vyconfd.ml
@@ -423,6 +423,16 @@ let reference_path_exists world token (req: request_reference_path_exists) =
     then response_tmpl
     else {response_tmpl with status=Fail}
 
+let get_path_type world token (req: request_get_path_type) =
+    let s = find_session token in
+    try
+        let node_type =
+            Session.get_path_type ~legacy_format:req.legacy_format world s req.path
+        in
+        {response_tmpl with output=(Some node_type)}
+    with Session.Session_error msg ->
+        {response_tmpl with status=Fail; error=(Some msg)}
+
 let send_response oc resp =
     let enc = Pbrt.Encoder.create () in
     let%lwt () = encode_pb_response resp enc |> return in
@@ -481,6 +491,7 @@ let rec handle_connection world ic oc () =
                     | Some t, Edit_level_root r -> edit_level_root world t r
                     | Some t, Config_unsaved r -> config_unsaved world t r
                     | Some t, Reference_path_exists r -> reference_path_exists world t r
+                    | Some t, Get_path_type r -> get_path_type world t r
                     | _ -> failwith "Unimplemented"
                     ) |> Lwt.return
                end