lanonna/pam/bin/main.ml

95 lines
2.9 KiB
OCaml
Raw Normal View History

2024-04-23 09:35:10 +02:00
open Pam.Datatypes
2024-05-01 12:03:26 +02:00
open Pam
2024-03-16 09:34:29 +01:00
open Batteries
2024-03-25 14:17:34 +01:00
open Utils
2024-03-16 09:34:29 +01:00
2024-03-25 14:17:34 +01:00
let _MQ_CLIENT = "mq_client"
let _HTTP_CLIENT = "http_client"
2024-04-17 18:18:19 +02:00
(*
* if the deadline has passed: alert every day at noon
* else parse the alert
**)
2024-04-02 14:38:00 +02:00
let http_client (repos: Config.repo_data list) =
let http_actor = Httpclient.init repos in
2024-04-24 09:58:14 +02:00
2024-05-01 12:03:26 +02:00
let _ = Pamlog.info "Initialized http client" in
2024-04-24 09:58:14 +02:00
2024-05-01 12:03:26 +02:00
let check_alert_time now issues =
let rec aux acc = function
| [] -> Ok acc
| issue :: rest ->
match Issuelib.to_datetime issue with
| Error e -> Error e
| Ok None -> aux acc rest
| Ok (Some alert_times) ->
let acc' =
if Issuelib.should_alert now alert_times then
issue::acc
else
acc
in aux acc' rest
in aux [] issues
2024-04-30 12:01:58 +02:00
in
2024-03-16 09:34:29 +01:00
let rec loop () =
2024-05-02 12:26:01 +02:00
let default_error_room = MatrixRoom.make "!KABwGlTSmXAbzCOhCX:goulash.lezzo.org" in (* TODO: remove hardcoded *)
2024-03-16 09:34:29 +01:00
let _ =
2024-04-30 12:01:58 +02:00
match Riot.receive_any () with
2024-03-25 14:17:34 +01:00
| ListIssues ->
2024-05-01 12:03:26 +02:00
let now = Ptime_clock.now () in
2024-04-30 12:01:58 +02:00
let issues = Httpclient.make_get_request http_actor
in
2024-05-01 12:03:26 +02:00
Result.bind issues (check_alert_time now)
2024-05-02 12:26:01 +02:00
|> Result.map_error (internal_failure default_error_room)
2024-04-30 12:01:58 +02:00
|> Result.fold ~ok:forgejo_issues ~error:List.singleton
2024-04-24 09:45:20 +02:00
|> List.map (Riot.send_by_name ~name:_MQ_CLIENT)
2024-03-25 14:17:34 +01:00
| m -> unhandled m
2024-03-16 09:34:29 +01:00
in
loop ()
in loop ()
2024-04-17 18:18:19 +02:00
let mq_client (mq_url, mq_user, mq_password) =
let call_consumer { Amqp_client_lwt.Message.message = (_content, body); _ } =
Pamlog.error [%string "Received msg from rabbitmq: %{body}. PAM will ignore."]
2024-03-25 14:17:34 +01:00
in
2024-04-17 18:18:19 +02:00
let%lwt mq = Mq.init (mq_url, mq_user, mq_password) call_consumer in
2024-03-16 09:34:29 +01:00
let rec loop () =
let%lwt _ = Lwt_unix.sleep 1.0 in
let _ =
try%lwt
2024-04-30 12:01:58 +02:00
match Riot.receive_any ~after:one_second () with
2024-05-02 12:26:01 +02:00
| InternalFailure (matrix_room, err) ->
2024-04-17 18:18:19 +02:00
let _ = Pamlog.error [%string "Got error from Forgejo: %{err}"] in
2024-05-02 12:26:01 +02:00
err |> Mq.error_msg_to_json_format matrix_room |> Mq.mq_publish mq
2024-04-24 09:45:20 +02:00
| Reminder reminder ->
2024-05-01 12:03:26 +02:00
let formatted = Issuelib.issue_data_to_json reminder in
Mq.mq_publish mq formatted
2024-03-25 14:17:34 +01:00
| m -> unhandled m
with | Riot.Receive_timeout -> Lwt.return_unit
2024-03-16 09:34:29 +01:00
in
loop ()
in
loop ()
2024-04-02 14:38:00 +02:00
let main (config: Config.config) =
2024-04-17 18:18:19 +02:00
let open Riot in
2024-04-02 14:38:00 +02:00
let http_client_pid = spawn (fun () -> http_client config.repos) in
2024-04-17 18:18:19 +02:00
let mq_client_pid = spawn (fun () -> Lwt_main.run (mq_client (config.mq_url, config.mq_user, config.mq_password))) in
2024-03-25 14:17:34 +01:00
let _ = Riot.register _HTTP_CLIENT http_client_pid in
let _ = Riot.register _MQ_CLIENT mq_client_pid
2024-03-16 09:34:29 +01:00
in
2024-05-02 11:54:36 +02:00
let timeout = 30.0 in
2024-03-25 14:17:34 +01:00
let rec loop_ () =
let _ = send http_client_pid ListIssues in
sleep timeout |> loop_
2024-03-16 09:34:29 +01:00
in
2024-03-25 14:17:34 +01:00
sleep timeout |> loop_
2024-03-16 09:34:29 +01:00
let () =
2024-04-02 14:38:00 +02:00
let config = Config.configuration () |> Result.fold ~error:exit2 ~ok:identity in
Riot.run (fun () -> main config)