aitest-reasonml-mon-fbk/lib/database.ml

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