feat: refactor ocaml tests and fix scheduling errors uncovered by the…

… tests

clients/ocaml/lib/date_time.ml

@@ -4,16 +4,23 @@ include Ptime
 
 type t = Ptime.t
 
+
+let from_ms ~ms =
+  let- date_time =
+    ms |> float_of_int
+    |> fun x ->
+    x /. 1000. |> Ptime.of_float_s
+  in
+  Some date_time
+;;
+
 let of_yojson json =
   match json with
   | `Int f ->
-      let@ date_time =
-        f |> float_of_int
-        |> fun x ->
-        x /. 1000. |> Ptime.of_float_s
-        |> Option.to_result ~none:"Invalid date time while parsing json"
+      let@ date_time = from_ms ~ms:f
+      |> Option.to_result ~none:"Invalid date time while parsing json"
       in
-      Ok date_time
+        Ok date_time
   | _ -> Error "Invalid date time while parsing json"
 ;;
 
@@ -25,7 +32,10 @@ let make_date_with_time ?(time = ((0, 0, 0), 0)) t =
 let of_span_exn span = Ptime.of_span span |> Option.get
 let add_span_exn t span = Ptime.add_span t span |> Option.get
 let sub_span_exn t span = Ptime.sub_span t span |> Option.get
+
 let to_seconds_exn t = Ptime.to_span t |> Ptime.Span.to_int_s |> Option.get
+let to_ms_exn t = to_seconds_exn t |> Int.mul 1000
+
 let start_of_day t = make_date_with_time t |> Ptime.of_date_time
 
 let end_of_day t =
@@ -47,6 +57,9 @@ let to_seconds_res t =
   Ptime.to_span t |> Ptime.Span.to_int_s |> Option.to_result ~none:`Invalid_date
 ;;
 
+let to_ms_res t = to_seconds_res t |> Result.map (fun seconds -> Int.mul seconds 1000)
+;;
+
 module Constants = struct
   let epoch = Ptime.epoch
   let one_day_seconds = 86400
@@ -63,6 +76,7 @@ module Span = struct
   ;;
 
   let to_seconds_exn span = to_int_s span |> Option.get
+  let of_days days = of_int_s (days * Constants.one_day_seconds)
   let of_hours hours = of_int_s (hours * Constants.one_hour_seconds)
   let of_seconds = of_int_s
 end

clients/ocaml/lib/schedule.ml

@@ -6,37 +6,49 @@ let is_schedule_active_with_now ~schedule ~schedule_type now =
   match schedule_type with
   | Empty -> Ok true
   | Environment | Global -> (
-      let@ beginning_of_start_date =
-        Date_time.start_of_day_res schedule.start
+      let@ start_date =
+        Date_time.from_ms ~ms:schedule.start
+        |> Option.to_result ~none:`Invalid_date
       in
-      let@ ending_of_end_date = Date_time.end_of_day_res schedule.end' in
+      let@ end_date =
+        Date_time.from_ms ~ms:schedule.end'
+        |> Option.to_result ~none:`Invalid_date
+      in
+      let@ start_of_start_date = Date_time.start_of_day_res start_date in
+      let@ end_of_end_date = Date_time.end_of_day_res end_date in
       if
-        Date_time.is_earlier now ~than:beginning_of_start_date
-        || Date_time.is_later now ~than:ending_of_end_date
+        Date_time.is_earlier now ~than:start_of_start_date
+        || Date_time.is_later now ~than:end_of_end_date
       then Ok false
       else
-        let _, start_time = Date_time.to_date_time schedule.start_time in
-        let _, end_time = Date_time.to_date_time schedule.end_time in
+        let@ start_date_ptime =
+          Date_time.from_ms ~ms:schedule.start_time
+          |> Option.to_result ~none:`Invalid_date
+        in
+        let _, start_time = Date_time.to_date_time start_date_ptime in
+        let@ end_date_ptime =
+          Date_time.from_ms ~ms:schedule.end_time
+          |> Option.to_result ~none:`Invalid_date
+        in
+        let _, end_time = Date_time.to_date_time end_date_ptime in
         match schedule.time_type with
         | None -> Ok true
         | Start_end ->
-            let@ start =
-              Date_time.(
-                of_date_time (to_date beginning_of_start_date, start_time))
-              |> Option.to_result ~none:`Invalid_date
+            let@ start_of_start_date_ms =
+              Date_time.to_ms_res start_of_start_date
             in
-            let@ end' =
-              Date_time.(of_date_time (to_date ending_of_end_date, end_time))
-              |> Option.to_result ~none:`Invalid_date
+            let@ start_of_end_date = Date_time.start_of_day_res end_date in
+            let@ start_of_end_date_ms = Date_time.to_ms_res start_of_end_date in
+            let@ now_ms = Date_time.to_ms_res now in
+
+            let is_after_start_date_time =
+              now_ms >= start_of_start_date_ms + schedule.start_time
+            in
+            let is_before_end_date_time =
+              now_ms <= start_of_end_date_ms + schedule.end_time
             in
-            let@ now_seconds = Date_time.to_seconds_res now in
-            let@ start_seconds = Date_time.to_seconds_res start in
-            let@ end_seconds = Date_time.to_seconds_res end' in
-            let is_after_start_date_time = now_seconds >= start_seconds in
-            let is_before_end_date_time = now_seconds <= end_seconds in
             Ok (is_after_start_date_time && is_before_end_date_time)
         | Daily ->
-            let now = Date_time.Clock.now () in
             let@ today_zero_timestamp =
               Date_time.to_date now |> Date_time.of_date
               |> Option.to_result ~none:`Invalid_date
@@ -49,13 +61,6 @@ let is_schedule_active_with_now ~schedule ~schedule_type now =
               Date_time.(of_date_time (to_date epoch, end_time))
               |> Option.to_result ~none:`Invalid_date
             in
-            let zeroed_end_span = Date_time.to_span zeroed_end_timestamp in
-            let day_span = Date_time.Span.of_int_s 86400 in
-            let@ zeroed_end_timestamp_plus_day =
-              Date_time.Span.add zeroed_end_span day_span
-              |> Date_time.of_span
-              |> Option.to_result ~none:`Invalid_date
-            in
             let@ start_timestamp =
               Date_time.(
                 Span.add
@@ -65,28 +70,26 @@ let is_schedule_active_with_now ~schedule ~schedule_type now =
               |> Option.to_result ~none:`Invalid_date
             in
             let@ end_timestamp =
-              if
-                Date_time.is_later ~than:zeroed_end_timestamp
-                  zeroed_start_timestamp
-              then
+              Date_time.(
+                Span.add
+                  (to_span today_zero_timestamp)
+                  (to_span zeroed_end_timestamp)
+                |> of_span)
+              |> Option.to_result ~none:`Invalid_date
+            in
+            if
+              Date_time.is_later ~than:zeroed_end_timestamp
+                zeroed_start_timestamp
+            then
+              Ok
                 Date_time.(
-                  Span.add
-                    (to_span today_zero_timestamp)
-                    (to_span zeroed_end_timestamp_plus_day)
-                  |> of_span)
-                |> Option.to_result ~none:`Invalid_date
-              else
+                  to_float_s now >= to_float_s start_timestamp
+                  || to_float_s now <= to_float_s end_timestamp)
+            else
+              Ok
                 Date_time.(
-                  Span.add
-                    (to_span today_zero_timestamp)
-                    (to_span zeroed_end_timestamp)
-                  |> of_span)
-                |> Option.to_result ~none:`Invalid_date
-            in
-            Ok
-              Date_time.(
-                to_float_s now > to_float_s start_timestamp
-                && to_float_s now < to_float_s end_timestamp))
+                  to_float_s now >= to_float_s start_timestamp
+                  && to_float_s now <= to_float_s end_timestamp))
 ;;
 
 let is_schedule_active ~schedule ~schedule_type =

clients/ocaml/lib/types.ml

@@ -54,12 +54,12 @@ module Schedule = struct
 
   (* Note: Assume that we are converting from milliseconds -> second for Date_time.t at (de)serialization boundaries*)
   type t = {
-    start : Date_time.t;
-    end' : Date_time.t; [@key "end"]
+    start : int;
+    end' : int; [@key "end"]
     timezone : timezone;
     time_type : time_type; [@key "timeType"]
-    start_time : Date_time.t; [@key "startTime"]
-    end_time : Date_time.t; [@key "endTime"]
+    start_time : int; [@key "startTime"]
+    end_time : int; [@key "endTime"]
   }
   [@@deriving make, show, of_yojson { strict = false }]
 end

clients/ocaml/test/dune

@@ -1,3 +1,3 @@
 (tests
  (names hash schedule client)
- (libraries alcotest alcotest-lwt vexilla))
+ (libraries alcotest alcotest-lwt vexilla fmt lwt))