(* Database models and connection handling *) open Lwt.Infix open Caqti_type (* Database connection pool *) let pool = ref None let pool_size = 5 (* Get database URL from environment *) let db_url () = try Sys.getenv "DATABASE_URL" with Not_found -> "postgresql://monitor_user:changeme@localhost:5432/website_monitor" (* Create database pool *) let create_pool () = let driver = Caqti_lwt.connect (Caqti_driver_postgres.connect ()) in let uri = Caqti_uri.of_string_exn (db_url ()) in let p = Caqti_pool.create ~max_size:pool_size driver uri in pool := Some p (* Website model *) module Website = struct type t = { id: int64; name: string; url: string; expected_status: int; timeout: int; check_interval: int; (* in seconds *) active: bool; created_at: Ptime.t; updated_at: Ptime.t; last_checked: Ptime.t option; last_status: int option; } let t = struct let get_id t = t.id let get_name t = t.name let get_url t = t.url let get_expected_status t = t.expected_status let get_timeout t = t.timeout let get_check_interval t = t.check_interval let get_active t = t.active let get_created_at t = t.created_at let get_updated_at t = t.updated_at let get_last_checked t = t.last_checked let get_last_status t = t.last_status end let create ~id ~name ~url ~expected_status ~timeout ~check_interval ~active ~created_at ~updated_at ~last_checked ~last_status = { id; name; url; expected_status; timeout; check_interval; active; created_at; updated_at; last_checked; last_status } end (* Get database connection pool *) let get_pool () = match !pool with | Some p -> p | None -> failwith "Database pool not initialized" (* Set database pool (called by Dream middleware) *) let set_pool p = pool := Some p (* Initialize database pool *) let initialize_pool () = () (* Note: When using Dream.sql_pool, the pool is passed via Dream.sql *) (* Alert model *) module Alert = struct type t = { id: int64; website_id: int64; alert_type: string; (* "email", "webhook", etc *) config: string; (* JSON config *) enabled: bool; created_at: Ptime.t; updated_at: Ptime.t; } let t = struct let get_id t = t.id let get_website_id t = t.website_id let get_alert_type t = t.alert_type let get_config t = t.config let get_enabled t = t.enabled let get_created_at t = t.created_at let get_updated_at t = t.updated_at end let create ~id ~website_id ~alert_type ~config ~enabled ~created_at ~updated_at = { id; website_id; alert_type; config; enabled; created_at; updated_at } end (* Check history model *) module CheckHistory = struct type t = { id: int64; website_id: int64; status_code: int; response_time: float; (* in milliseconds *) error_message: string option; checked_at: Ptime.t; } let t = struct let get_id t = t.id let get_website_id t = t.website_id let get_status_code t = t.status_code let get_response_time t = t.response_time let get_error_message t = t.error_message let get_checked_at t = t.checked_at end let create ~id ~website_id ~status_code ~response_time ~error_message ~checked_at = { id; website_id; status_code; response_time; error_message; checked_at } end (* Initialize database schema *) let init_schema () = let queries = [| Websites.create_table; Alerts.create_table; CheckHistories.create_table |] in let p = get_pool () in Lwt_list.iter_s (fun q -> Caqti_request.exec p q ()) queries >>= fun () -> Logs.app (fun m -> m "Database schema initialized"); Lwt.return_unit module Websites = struct let create_table = Caqti_request.exec Caqti_type.unit {sql| CREATE TABLE IF NOT EXISTS websites ( id BIGSERIAL PRIMARY KEY, name TEXT NOT NULL, url TEXT NOT NULL UNIQUE, expected_status INTEGER NOT NULL DEFAULT 200, timeout INTEGER NOT NULL DEFAULT 30, check_interval INTEGER NOT NULL DEFAULT 300, active BOOLEAN NOT NULL DEFAULT true, created_at TIMESTAMP WITH TIME ZONE NOT NULL DEFAULT NOW(), updated_at TIMESTAMP WITH TIME ZONE NOT NULL DEFAULT NOW(), last_checked TIMESTAMP WITH TIME ZONE, last_status INTEGER ) |sql} let get_all = Caqti_request.collect Caqti_type.unit (struct let columns = Caqti_type.( product (unit_of int64) @@ product (unit_of string) @@ product (unit_of string) @@ product (unit_of int) @@ product (unit_of int) @@ product (unit_of int) @@ product (unit_of bool) @@ product (unit_of Ptime.t) @@ product (unit_of Ptime.t) @@ product (option (unit_of Ptime.t)) @@ option (unit_of int)) end) {sql| SELECT id, name, url, expected_status, timeout, check_interval, active, created_at, updated_at, last_checked, last_status FROM websites ORDER BY name |sql} let get_by_id id = Caqti_request.find_opt Caqti_type.(int64) (struct let columns = Caqti_type.( product (unit_of int64) @@ product (unit_of string) @@ product (unit_of string) @@ product (unit_of int) @@ product (unit_of int) @@ product (unit_of int) @@ product (unit_of bool) @@ product (unit_of Ptime.t) @@ product (unit_of Ptime.t) @@ product (option (unit_of Ptime.t)) @@ option (unit_of int)) end) {sql| SELECT id, name, url, expected_status, timeout, check_interval, active, created_at, updated_at, last_checked, last_status FROM websites WHERE id = $1 |sql} let create_website name url expected_status timeout check_interval = Caqti_request.exec Caqti_type.( product string @@ product string @@ product int @@ product int @@ product int) {sql| INSERT INTO websites (name, url, expected_status, timeout, check_interval) VALUES ($1, $2, $3, $4, $5) |sql} let update_website id name url expected_status timeout check_interval active = Caqti_request.exec Caqti_type.( product int64 @@ product string @@ product string @@ product int @@ product int @@ product int @@ product bool) {sql| UPDATE websites SET name = $2, url = $3, expected_status = $4, timeout = $5, check_interval = $6, active = $7, updated_at = NOW() WHERE id = $1 |sql} let delete_website id = Caqti_request.exec Caqti_type.(int64) {sql|DELETE FROM websites WHERE id = $1|sql} let update_status id last_checked last_status = Caqti_request.exec Caqti_type.(product int64 @@ product Ptime.t @@ option int) {sql| UPDATE websites SET last_checked = $2, last_status = $3 WHERE id = $1 |sql} let get_active = Caqti_request.collect Caqti_type.unit (struct let columns = Caqti_type.( product (unit_of int64) @@ product (unit_of string) @@ product (unit_of string) @@ product (unit_of int) @@ product (unit_of int) @@ product (unit_of int) @@ product (unit_of bool) @@ product (unit_of Ptime.t) @@ product (unit_of Ptime.t) @@ product (option (unit_of Ptime.t)) @@ option (unit_of int)) end) {sql| SELECT id, name, url, expected_status, timeout, check_interval, active, created_at, updated_at, last_checked, last_status FROM websites WHERE active = true ORDER BY check_interval |sql} end module Alerts = struct let create_table = Caqti_request.exec Caqti_type.unit {sql| CREATE TABLE IF NOT EXISTS alerts ( id BIGSERIAL PRIMARY KEY, website_id BIGINT NOT NULL REFERENCES websites(id) ON DELETE CASCADE, alert_type TEXT NOT NULL, config JSONB NOT NULL, enabled BOOLEAN NOT NULL DEFAULT true, created_at TIMESTAMP WITH TIME ZONE NOT NULL DEFAULT NOW(), updated_at TIMESTAMP WITH TIME ZONE NOT NULL DEFAULT NOW(), UNIQUE(website_id, alert_type) ) |sql} let get_all = Caqti_request.collect Caqti_type.unit (struct let columns = Caqti_type.( product (unit_of int64) @@ product (unit_of int64) @@ product (unit_of string) @@ product (unit_of string) @@ product (unit_of bool) @@ product (unit_of Ptime.t) @@ product (unit_of Ptime.t)) end) {sql| SELECT id, website_id, alert_type, config, enabled, created_at, updated_at FROM alerts ORDER BY created_at DESC |sql} let get_by_id id = Caqti_request.find_opt Caqti_type.(int64) (struct let columns = Caqti_type.( product (unit_of int64) @@ product (unit_of int64) @@ product (unit_of string) @@ product (unit_of string) @@ product (unit_of bool) @@ product (unit_of Ptime.t) @@ product (unit_of Ptime.t)) end) {sql| SELECT id, website_id, alert_type, config, enabled, created_at, updated_at FROM alerts WHERE id = $1 |sql} let get_by_website_id website_id = Caqti_request.collect Caqti_type.(int64) (struct let columns = Caqti_type.( product (unit_of int64) @@ product (unit_of int64) @@ product (unit_of string) @@ product (unit_of string) @@ product (unit_of bool) @@ product (unit_of Ptime.t) @@ product (unit_of Ptime.t)) end) {sql| SELECT id, website_id, alert_type, config, enabled, created_at, updated_at FROM alerts WHERE website_id = $1 AND enabled = true |sql} let create_alert website_id alert_type config = Caqti_request.exec Caqti_type.(product int64 @@ product string @@ product string) {sql| INSERT INTO alerts (website_id, alert_type, config) VALUES ($1, $2, $3) |sql} let update_alert id alert_type config enabled = Caqti_request.exec Caqti_type.(product int64 @@ product string @@ product string @@ product bool) {sql| UPDATE alerts SET alert_type = $2, config = $3, enabled = $4, updated_at = NOW() WHERE id = $1 |sql} let delete_alert id = Caqti_request.exec Caqti_type.(int64) {sql|DELETE FROM alerts WHERE id = $1|sql} end module CheckHistories = struct let create_table = Caqti_request.exec Caqti_type.unit {sql| CREATE TABLE IF NOT EXISTS check_histories ( id BIGSERIAL PRIMARY KEY, website_id BIGINT NOT NULL REFERENCES websites(id) ON DELETE CASCADE, status_code INTEGER NOT NULL, response_time REAL NOT NULL, error_message TEXT, checked_at TIMESTAMP WITH TIME ZONE NOT NULL DEFAULT NOW() ) |sql} let get_by_website_id website_id limit = Caqti_request.collect Caqti_type.(product int64 @@ product int) (struct let columns = Caqti_type.( product (unit_of int64) @@ product (unit_of int64) @@ product (unit_of int) @@ product (unit_of float) @@ option (unit_of string) @@ product (unit_of Ptime.t)) end) {sql| SELECT id, website_id, status_code, response_time, error_message, checked_at FROM check_histories WHERE website_id = $1 ORDER BY checked_at DESC LIMIT $2 |sql} let create website_id status_code response_time error_message = Caqti_request.exec Caqti_type.( product int64 @@ product int @@ product float @@ option string) {sql| INSERT INTO check_histories (website_id, status_code, response_time, error_message) VALUES ($1, $2, $3, $4) |sql} let cleanup_old_website_history website_id days = Caqti_request.exec Caqti_type.(product int64 @@ product int) {sql| DELETE FROM check_histories WHERE website_id = $1 AND checked_at < NOW() - INTERVAL '1 day' * $2 |sql} end