Files
aitest-reasonml-mon-fbk/lib/alert.ml
Charles N Wyble e1ff581603 feat: initial commit - complete website monitoring application
Build a comprehensive website monitoring application with ReasonML, OCaml, and server-reason-react.

Features:
- Real-time website monitoring with HTTP status checks
- Email and webhook alerting system
- Beautiful admin dashboard with Tailwind CSS
- Complete REST API for CRUD operations
- Background monitoring scheduler
- Multi-container Docker setup with 1-core CPU constraint
- PostgreSQL database with Caqti
- Full documentation and setup guides

Tech Stack:
- OCaml 5.0+ with ReasonML
- Dream web framework
- server-reason-react for UI
- PostgreSQL 16 database
- Docker & Docker Compose

Files:
- 9 OCaml source files (1961 LOC)
- 6 documentation files (1603 LOC)
- Complete Docker configuration
- Comprehensive API documentation

💘 Generated with Crush
2026-01-13 15:56:42 -05:00

208 lines
6.4 KiB
OCaml

(* 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")])