IH-747 - database: Add an internal get_by_uuid_opt method

Instead of raising an exception in case of an error like get_by_uuid,
return None to be handled gracefully later.

Do not expose it in the datamodel.

This will later be used when an object is checked to exist before its creation
(during migration, for example), and so its absence is expected - no need to
raise a backtrace and pollute the logs with errors.

Signed-off-by: Andrii Sultanov <[email protected]>

ocaml/database/db_cache_impl.ml

@@ -240,6 +240,21 @@ let db_get_by_uuid t tbl uuid_val =
   | _ ->
       raise (Too_many_values (tbl, "", uuid_val))
 
+let db_get_by_uuid_opt t tbl uuid_val =
+  match
+    read_field_where t
+      {
+        table= tbl
+      ; return= Db_names.ref
+      ; where_field= Db_names.uuid
+      ; where_value= uuid_val
+      }
+  with
+  | [r] ->
+      Some r
+  | _ ->
+      None
+
 (** Return reference fields from tbl that matches specified name_label field *)
 let db_get_by_name_label t tbl label =
   read_field_where t

ocaml/database/db_interface.ml

@@ -56,6 +56,11 @@ module type DB_ACCESS = sig
   (** [db_get_by_uuid tbl uuid] returns the single object reference
       		associated with [uuid] *)
 
+  val db_get_by_uuid_opt : Db_ref.t -> string -> string -> string option
+  (** [db_get_by_uuid_opt tbl uuid] returns [Some obj] with the single object
+          reference associated with [uuid] if one exists and [None] otherwise,
+          instead of raising an exception like [get_by_uuid] *)
+
   val db_get_by_name_label : Db_ref.t -> string -> string -> string list
   (** [db_get_by_name_label tbl label] returns the list of object references
       		associated with [label] *)

ocaml/database/db_rpc_client_v1.ml

@@ -88,6 +88,10 @@ functor
       do_remote_call marshall_db_get_by_uuid_args
         unmarshall_db_get_by_uuid_response "db_get_by_uuid" (t, u)
 
+    let db_get_by_uuid_opt _ t u =
+      do_remote_call marshall_db_get_by_uuid_args
+        unmarshall_db_get_by_uuid_opt_response "db_get_by_uuid_opt" (t, u)
+
     let db_get_by_name_label _ t l =
       do_remote_call marshall_db_get_by_name_label_args
         unmarshall_db_get_by_name_label_response "db_get_by_name_label" (t, l)

ocaml/database/db_rpc_client_v2.ml

@@ -77,6 +77,13 @@ functor
       | _ ->
           raise Remote_db_server_returned_bad_message
 
+    let db_get_by_uuid_opt _ t u =
+      match process (Request.Db_get_by_uuid (t, u)) with
+      | Response.Db_get_by_uuid_opt y ->
+          y
+      | _ ->
+          raise Remote_db_server_returned_bad_message
+
     let db_get_by_name_label _ t l =
       match process (Request.Db_get_by_name_label (t, l)) with
       | Response.Db_get_by_name_label y ->

ocaml/database/db_rpc_common_v1.ml

@@ -194,6 +194,8 @@ let marshall_db_get_by_uuid_response s = XMLRPC.To.string s
 
 let unmarshall_db_get_by_uuid_response xml = XMLRPC.From.string xml
 
+let unmarshall_db_get_by_uuid_opt_response xml = unmarshall_stringopt xml
+
 (* db_get_by_name_label *)
 let marshall_db_get_by_name_label_args (s1, s2) = marshall_2strings (s1, s2)
 

ocaml/database/db_rpc_common_v2.ml

@@ -59,6 +59,7 @@ module Response = struct
     | Find_refs_with_filter of string list
     | Read_field_where of string list
     | Db_get_by_uuid of string
+    | Db_get_by_uuid_opt of string option
     | Db_get_by_name_label of string list
     | Create_row of unit
     | Delete_row of unit

ocaml/idl/ocaml_backend/gen_db_actions.ml

@@ -93,6 +93,8 @@ let dm_to_string tys : O.Module.t =
           "fun x -> x |> SecretString.rpc_of_t |> Rpc.string_of_rpc"
       | DT.Record _ ->
           failwith "record types never stored in the database"
+      | DT.Option (DT.Ref _ as ty) ->
+          "fun s -> set " ^ OU.alias_of_ty ty ^ "(Option.to_list s)"
       | DT.Option _ ->
           failwith "option types never stored in the database"
     in
@@ -148,6 +150,10 @@ let string_to_dm tys : O.Module.t =
           "SecretString.of_string"
       | DT.Record _ ->
           failwith "record types never stored in the database"
+      | DT.Option (DT.Ref _ as ty) ->
+          "fun s -> match set "
+          ^ OU.alias_of_ty ty
+          ^ " s with [] -> None | x::_ -> Some x"
       | DT.Option _ ->
           failwith "option types never stored in the database"
     in
@@ -515,7 +521,32 @@ let db_action api : O.Module.t =
                 (Escaping.escape_obj obj.DT.name)
                 (OU.escape name)
             in
-            _string_to_dm ^ "." ^ OU.alias_of_ty result_ty ^ " (" ^ query ^ ")"
+            let func =
+              _string_to_dm
+              ^ "."
+              ^ OU.alias_of_ty result_ty
+              ^ " ("
+              ^ query
+              ^ ")"
+            in
+            let query_opt =
+              Printf.sprintf "DB.db_get_by_uuid_opt __t \"%s\" %s"
+                (Escaping.escape_obj obj.DT.name)
+                (OU.escape name)
+            in
+            String.concat "\n\t\t"
+              ([func]
+              @ [
+                  String.concat "\n\t\t  "
+                    (["and get_by_uuid_opt ~__context ~uuid ="]
+                    @ open_db_module
+                    @ [
+                        Printf.sprintf "Option.map %s.%s (%s)" _string_to_dm
+                          (OU.alias_of_ty result_ty) query_opt
+                      ]
+                    )
+                ]
+              )
         | _ ->
             failwith
               "GetByUuid call should have only one parameter and a result!"