(* Alerting system for website monitoring *) open Lwt.Infix open Database (* Email alert configuration *) type email_config = { to_email: string; cc_email: string option; subject_prefix: string; } (* Webhook alert configuration *) type webhook_config = { url: string; method_: string; headers: (string * string) list; body_template: string; } (* Parse email config from JSON *) let parse_email_config (json : Yojson.Basic.t) : email_config = let open Yojson.Basic.Util in { to_email = json |> member "to_email" |> to_string; cc_email = (try Some (json |> member "cc_email" |> to_string) with _ -> None); subject_prefix = (try json |> member "subject_prefix" |> to_string with _ -> "[Monitor]"); } (* Parse webhook config from JSON *) let parse_webhook_config (json : Yojson.Basic.t) : webhook_config = let open Yojson.Basic.Util in { url = json |> member "url" |> to_string; method_ = (try json |> member "method" |> to_string with _ -> "POST"); headers = (try json |> member "headers" |> to_assoc with _ -> []); body_template = (try json |> member "body_template" |> to_string with _ -> ""); } (* Send email alert *) let send_email (config : email_config) (website : Website.t) (result : Monitor.check_result) : unit Lwt.t = let smtp_host = try Sys.getenv "SMTP_HOST" with Not_found -> "smtp.gmail.com" in let smtp_port = try int_of_string (Sys.getenv "SMTP_PORT") with Not_found -> 587 in let smtp_user = try Some (Sys.getenv "SMTP_USER") with Not_found -> None in let smtp_password = try Some (Sys.getenv "SMTP_PASSWORD") with Not_found -> None in (* For now, we'll log the email that would be sent *) (* In production, you'd use a proper SMTP library like sendmail or direct SMTP *) let subject = Printf.sprintf "%s %s %s: %s" config.subject_prefix website.name (if result.is_success then "Recovery" else "Alert") (match result.status_code with | 0 -> "Connection Failed" | n -> Printf.sprintf "HTTP %d" n) in let body = Printf.sprintf {|Website: %s URL: %s Expected Status: %d Actual Status: %d Response Time: %.2fms Time: %s %s|} website.name website.url website.expected_status result.status_code result.response_time (try Ptime.to_rfc3339 (Ptime.v (Unix.gettimeofday ())) with _ -> "N/A") (match result.error_message with | None -> "" | Some msg -> Printf.sprintf "Error: %s\n" msg) in Logs.app (fun m -> m "Email alert would be sent to %s\nSubject: %s\nBody:\n%s" config.to_email subject body); (* Placeholder for actual email sending *) (* You would use a library like ocaml-camomile, sendmail, or SMTP client here *) Lwt.return_unit (* Send webhook alert *) let send_webhook (config : webhook_config) (website : Website.t) (result : Monitor.check_result) : unit Lwt.t = let body = let body_json = Yojson.Basic.( `Assoc [ ("website_id", `String (Int64.to_string website.id)); ("website_name", `String website.name); ("website_url", `String website.url); ("status_code", `Int result.status_code); ("response_time", `Float result.response_time); ("is_success", `Bool result.is_success); ("error_message", (match result.error_message with | None -> `Null | Some msg -> `String msg)); ("timestamp", `String (try Ptime.to_rfc3339 (Ptime.v (Unix.gettimeofday ())) with _ -> "")); ]) in if String.length config.body_template > 0 then (* In production, you'd do template substitution *) Yojson.Basic.to_string body_json else Yojson.Basic.to_string body_json in let uri = Uri.of_string config.url in let method_ = match String.uppercase_ascii config.method_ with | "GET" -> `GET | "POST" -> `POST | "PUT" -> `PUT | _ -> `POST in (* Create headers *) let headers = Cohttp.Header.of_list (("Content-Type", "application/json") :: config.headers) in Cohttp_lwt_unix.Client.request ~uri ~headers ?body:(Some (Cohttp_lwt.Body.of_string body)) method_ >>= fun (_, _) -> Logs.app (fun m -> m "Webhook alert sent to %s" config.url); Lwt.return_unit |> Lwt.catch (fun exn -> Logs.err (fun m -> m "Failed to send webhook alert to %s: %s" config.url (Printexc.to_string exn)); Lwt.return_unit) (* Trigger alerts for a website check result *) let trigger_alerts (website : Website.t) (result : Monitor.check_result) : unit Lwt.t = (* Only trigger alerts for failures, or on recovery *) Alerts.get_by_website_id website.id >>= fun alerts -> Lwt_list.iter_s (fun (alert : Alert.t) -> if not alert.enabled then Lwt.return_unit else try let config_json = Yojson.Basic.from_string alert.config in match alert.alert_type with | "email" -> let email_config = parse_email_config config_json in send_email email_config website result | "webhook" -> let webhook_config = parse_webhook_config config_json in send_webhook webhook_config website result | _ -> Logs.warn (fun m -> m "Unknown alert type: %s" alert.alert_type); Lwt.return_unit with exn -> Logs.err (fun m -> m "Error parsing alert config for website %s: %s" website.name (Printexc.to_string exn)); Lwt.return_unit) alerts >>= fun () -> Lwt.return_unit (* Send test alert *) let send_test_alert (alert_id : int64) : Yojson.Basic.t Lwt.t = Alerts.get_by_id alert_id >>= function | None -> Lwt.return Yojson.Basic.(`Assoc [("success", `Bool false); ("error", `String "Alert not found")]) | Some alert -> Websites.get_by_id alert.website_id >>= function | None -> Lwt.return Yojson.Basic.(`Assoc [("success", `Bool false); ("error", `String "Website not found")]) | Some website -> let test_result = { Monitor.status_code = 200; response_time = 100.0; error_message = None; is_success = false; (* Force failure to test alert *) } in trigger_alerts website test_result >>= fun () -> Lwt.return Yojson.Basic.(`Assoc [("success", `Bool true); ("message", `String "Test alert sent")])