(* Website monitoring logic *) open Lwt.Infix open Cohttp open Cohttp_lwt_unix open Database (* Result of a website check *) type check_result = { status_code: int; response_time: float; (* milliseconds *) error_message: string option; is_success: bool; } (* Check a single website *) let check_website (website : Website.t) : check_result Lwt.t = let start_time = Unix.gettimeofday () in let uri = try Uri.of_string website.url with _ -> failwith (Printf.sprintf "Invalid URL: %s" website.url) in (* Create HTTP client with timeout *) let timeout = website.timeout in let client = Client.conns ~connection_timeout:(float_of_int timeout) () in (* Make HTTP request *) Client.get ~uri client >>= fun (response, body) -> let end_time = Unix.gettimeofday () in let response_time = (end_time -. start_time) *. 1000.0 in let status_code = Code.code_of_status (Cohttp.Response.status response) in let is_success = status_code = website.expected_status && Code.is_success status_code in let result = { status_code; response_time; error_message = None; is_success; } in (* Drain body to complete request *) Cohttp_lwt.Body.to_string body >>= fun _body -> Lwt.return result |> Lwt.catch (fun exn -> let error_message = Some (Printexc.to_string exn) in let result = { status_code = 0; response_time = (Unix.gettimeofday () -. start_time) *. 1000.0; error_message; is_success = false; } in Lwt.return result) (* Check website and store result *) let check_and_store_website (website : Website.t) : unit Lwt.t = Logs.app (fun m -> m "Checking website: %s (%s)" website.name website.url); check_website website >>= fun result -> let now = Ptime.v (Unix.gettimeofday ()) in (* Store check history *) let error_message = match result.error_message with | None -> None | Some msg -> Some msg in CheckHistories.create website.id result.status_code result.response_time error_message >>= fun () -> (* Update website status *) let last_status = Some result.status_code in let last_checked = now in Websites.update_status website.id last_checked last_status >>= fun () -> Logs.app (fun m -> m "Website %s check result: status=%d, time=%.2fms, success=%b" website.name result.status_code result.response_time result.is_success); (* Trigger alerts if needed *) Alert.trigger_alerts website result >>= fun () -> Lwt.return_unit |> Lwt.catch (fun exn -> Logs.err (fun m -> m "Error checking website %s: %s" website.name (Printexc.to_string exn)); Lwt.return_unit) (* Check all active websites *) let check_all_active_websites () : unit Lwt.t = Websites.get_active () >>= fun websites -> Lwt_list.iter_p check_and_store_website websites >>= fun () -> Logs.app (fun m -> m "Completed checking all active websites"); Lwt.return_unit (* Get current status summary for a website *) let get_website_status (website_id : int64) : Yojson.Basic.t Lwt.t = Websites.get_by_id website_id >>= function | None -> Lwt.return Yojson.Basic.(`Null) | Some website -> CheckHistories.get_by_website_id website_id 10 >>= fun histories -> let recent_checks = List.map (fun (h : CheckHistory.t) -> Yojson.Basic.( `Assoc [ ("id", `String (Int64.to_string h.id)); ("status_code", `Int h.status_code); ("response_time", `Float h.response_time); ("error_message", (match h.error_message with | None -> `Null | Some msg -> `String msg)); ("checked_at", `String (Ptime.to_rfc3339 h.checked_at)); ])) histories in let website_json = Yojson.Basic.( `Assoc [ ("id", `String (Int64.to_string website.id)); ("name", `String website.name); ("url", `String website.url); ("expected_status", `Int website.expected_status); ("active", `Bool website.active); ("last_checked", (match website.last_checked with | None -> `Null | Some t -> `String (Ptime.to_rfc3339 t))); ("last_status", (match website.last_status with | None -> `Null | Some s -> `Int s)); ("recent_checks", `List recent_checks); ]) in Lwt.return website_json