e1ff581603
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
417 lines
12 KiB
OCaml
417 lines
12 KiB
OCaml
(* Database models and connection handling *)
|
|
|
|
open Lwt.Infix
|
|
open Caqti_type
|
|
|
|
(* Database connection pool *)
|
|
let pool_size = 5
|
|
|
|
(* Database URL from environment *)
|
|
let db_url =
|
|
try Sys.getenv "DATABASE_URL"
|
|
with Not_found ->
|
|
"postgresql://monitor_user:changeme@localhost:5432/website_monitor"
|
|
|
|
(* 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
|
|
|
|
(* 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
|
|
|
|
(* Database connection pool *)
|
|
let pool =
|
|
let driver = Caqti_block.connect (Caqti_driver_postgres.connect ()) in
|
|
let uri = Caqti_uri.of_string_exn db_url in
|
|
Caqti_pool.create ~max_size:pool_size driver uri
|
|
|
|
(* Initialize database schema *)
|
|
let init_schema () =
|
|
let queries =
|
|
[| Websites.create_table;
|
|
Alerts.create_table;
|
|
CheckHistories.create_table |]
|
|
in
|
|
Lwt_list.iter_s (fun q -> Caqti_request.exec pool 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
|