idl: Add Rate_limit datamodel

Signed-off-by: Christian Pardillo Laursen <[email protected]>

Author: cplaursen

ocaml/idl/datamodel.ml

@@ -10535,6 +10535,7 @@ let all_system =
   ; Datamodel_vm_group.t
   ; Datamodel_host_driver.t
   ; Datamodel_driver_variant.t
+  ; Datamodel_rate_limit.t
   ]
 
 (* If the relation is one-to-many, the "many" nodes (one edge each) must come before the "one" node (many edges) *)
@@ -10786,6 +10787,7 @@ let expose_get_all_messages_for =
   ; _observer
   ; _host_driver
   ; _driver_variant
+  ; _rate_limit
   ]
 
 let no_task_id_for = [_task; (* _alert; *) _event]

ocaml/idl/datamodel_common.ml

@@ -315,6 +315,8 @@ let _host_driver = "Host_driver"
 
 let _driver_variant = "Driver_variant"
 
+let _rate_limit = "Rate_limit"
+
 let update_guidances =
   Enum
     ( "update_guidances"

ocaml/idl/datamodel_lifecycle.ml

@@ -1,4 +1,6 @@
 let prototyped_of_class = function
+  | "Rate_limit" ->
+      Some "25.38.0-next"
   | "Driver_variant" ->
       Some "25.2.0"
   | "Host_driver" ->
@@ -13,6 +15,14 @@ let prototyped_of_class = function
       None
 
 let prototyped_of_field = function
+  | "Rate_limit", "fill_rate" ->
+      Some "25.38.0-next"
+  | "Rate_limit", "burst_size" ->
+      Some "25.38.0-next"
+  | "Rate_limit", "client_id" ->
+      Some "25.38.0-next"
+  | "Rate_limit", "uuid" ->
+      Some "25.38.0-next"
   | "Driver_variant", "status" ->
       Some "25.2.0"
   | "Driver_variant", "priority" ->

ocaml/idl/datamodel_rate_limit.ml

@@ -0,0 +1,40 @@
+(*
+ * Copyright (C) 2023 Cloud Software Group
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+open Datamodel_types
+open Datamodel_common
+open Datamodel_roles
+
+let lifecycle = []
+
+let t =
+  create_obj ~name:_rate_limit ~descr:"Rate limiting policy for a XAPI client"
+    ~doccomments:[] ~gen_constructor_destructor:true ~gen_events:true
+    ~in_db:true ~lifecycle:[] ~persist:PersistEverything ~in_oss_since:None
+    ~messages_default_allowed_roles:_R_POOL_ADMIN
+    ~contents:
+      ([uid _rate_limit ~lifecycle]
+      @ [
+          field ~qualifier:StaticRO ~ty:String ~lifecycle "client_id"
+            "An identifier for the rate limited client" ~ignore_foreign_key:true
+            ~default_value:(Some (VString ""))
+        ; field ~qualifier:StaticRO ~ty:Float ~lifecycle "burst_size"
+            "Amount of tokens that can be consumed in one burst"
+            ~ignore_foreign_key:true ~default_value:(Some (VFloat 0.))
+        ; field ~qualifier:StaticRO ~ty:Float ~lifecycle "fill_rate"
+            "Tokens added to token bucket per second" ~ignore_foreign_key:true
+            ~default_value:(Some (VFloat 0.))
+        ]
+      )
+    ~messages:[] ()

ocaml/idl/dune

@@ -7,7 +7,7 @@
     datamodel_values datamodel_schema datamodel_certificate
     datamodel_diagnostics datamodel_repository datamodel_lifecycle
     datamodel_vtpm datamodel_observer datamodel_vm_group api_version
-    datamodel_host_driver datamodel_driver_variant)
+    datamodel_host_driver datamodel_driver_variant datamodel_rate_limit)
   (libraries
     rpclib.core
     sexplib0

ocaml/idl/schematest.ml

@@ -3,7 +3,7 @@ let hash x = Digest.string x |> Digest.to_hex
 (* BEWARE: if this changes, check that schema has been bumped accordingly in
    ocaml/idl/datamodel_common.ml, usually schema_minor_vsn *)
 
-let last_known_schema_hash = "3b20f4304cfaaa7b6213af91ae632e64"
+let last_known_schema_hash = "4708cb1f0cf7c1231c6958590ee1ed04"
 
 let current_schema_hash : string =
   let open Datamodel_types in

ocaml/libs/rate-limit/bucket_table.ml

@@ -31,6 +31,10 @@ let with_lock = Xapi_stdext_threads.Threadext.Mutex.execute
 
 let create () = Atomic.make StringMap.empty
 
+let mem t ~user_agent =
+  let map = Atomic.get t in
+  StringMap.mem user_agent map
+
 (* The worker thread is responsible for calling the callback when the token
    amount becomes available *)
 let rec worker_loop ~bucket ~process_queue ~process_queue_lock

ocaml/libs/rate-limit/bucket_table.mli

@@ -22,7 +22,11 @@ val add_bucket :
   t -> user_agent:string -> burst_size:float -> fill_rate:float -> bool
 (** [add_bucket table ~user_agent ~burst_size ~fill_rate] adds a token bucket
     for the given user agent. Returns [false] if a bucket already exists, or if
-    the bucket configuration is invalid, e.g. negative fill rate. *)
+    the bucket configuration is invalid, e.g. negative/zero fill rate. *)
+
+val mem : t -> user_agent:string -> bool
+(** [mem table ~user_agent] returns whether [user_agent] has an associated
+    token bucket in the bucket table *)
 
 val peek : t -> user_agent:string -> float option
 (** [peek table ~user_agent] returns the current token count for the user agent,

ocaml/libs/rate-limit/test/test_token_bucket.ml

@@ -122,7 +122,7 @@ let test_sleep () =
   let tb = Option.get (Token_bucket.create ~burst_size:20.0 ~fill_rate:5.0) in
   let _ = Token_bucket.consume tb 10.0 in
   Thread.delay 1.0 ;
-  Alcotest.(check (float 0.2))
+  Alcotest.(check (float 0.5))
     "Sleep 1 should refill token bucket by fill_rate" 15.0 (Token_bucket.peek tb)
 
 let test_system_time_versions () =

ocaml/libs/uuid/uuidx.ml

@@ -64,6 +64,7 @@ type without_secret =
   | `sr_stat
   | `subject
   | `task
+  | `Rate_limit
   | `tunnel
   | `USB_group
   | `user