Files
aitest-reasonml-mon-fbk/lib/monitor.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

159 lines
4.5 KiB
OCaml

(* 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