LEZZO.ORG/lanonna
2
Fork 0
Code Issues 2 Pull requests Projects Releases Packages Wiki Activity

burrodiarachidi

Browse source
This commit is contained in:
Benedetta 2024-05-02 12:26:01 +02:00
parent 5c3cbbd849
commit 2a0450a4d9
4 changed files with 19 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
pam/bin/main.ml
View file

@ -32,6 +32,7 @@ let http_client (repos: Config.repo_data list) =
in aux [] issues in aux [] issues
in in
let rec loop () = let rec loop () =
let default_error_room = MatrixRoom.make "!KABwGlTSmXAbzCOhCX:goulash.lezzo.org" in (* TODO: remove hardcoded *)
let _ = let _ =
match Riot.receive_any () with match Riot.receive_any () with
| ListIssues -> | ListIssues ->
@ -39,7 +40,7 @@ let http_client (repos: Config.repo_data list) =
let issues = Httpclient.make_get_request http_actor let issues = Httpclient.make_get_request http_actor
in in
Result.bind issues (check_alert_time now) Result.bind issues (check_alert_time now)
|> Result.map_error internal_failure |> Result.map_error (internal_failure default_error_room)
|> Result.fold ~ok:forgejo_issues ~error:List.singleton |> Result.fold ~ok:forgejo_issues ~error:List.singleton
|> List.map (Riot.send_by_name ~name:_MQ_CLIENT) |> List.map (Riot.send_by_name ~name:_MQ_CLIENT)
| m -> unhandled m | m -> unhandled m
@ -59,9 +60,9 @@ let mq_client (mq_url, mq_user, mq_password) =
let _ = let _ =
try%lwt try%lwt
match Riot.receive_any ~after:one_second () with match Riot.receive_any ~after:one_second () with
| InternalFailure err -> | InternalFailure (matrix_room, err) ->
let _ = Pamlog.error [%string "Got error from Forgejo: %{err}"] in let _ = Pamlog.error [%string "Got error from Forgejo: %{err}"] in
Mq.mq_publish mq err err |> Mq.error_msg_to_json_format matrix_room |> Mq.mq_publish mq
| Reminder reminder -> | Reminder reminder ->
let formatted = Issuelib.issue_data_to_json reminder in let formatted = Issuelib.issue_data_to_json reminder in
Mq.mq_publish mq formatted Mq.mq_publish mq formatted

12
pam/bin/mq.ml
View file

@ -32,3 +32,15 @@ let mq_publish {queue=_; channel=channel; connection=_} msg =
Message.make msg Message.make msg
|> Exchange.publish channel Exchange.default ~routing_key:"lanonna" |> Exchange.publish channel Exchange.default ~routing_key:"lanonna"
in Lwt.return_unit in Lwt.return_unit
let error_msg_to_json_format room_id error =
let open Yojson.Basic in
let content = [%string {|Pam è entrata in errore: %{error}| |}] in
let d = `Assoc [
("content", `String content);
("source_message_id", `Null);
("room_id", `String room_id);
("as_reply", `Bool false);
("as_markdown", `Bool true)
] in
to_string d

4
pam/lib/datatypes.ml
View file

@ -19,7 +19,7 @@ type Riot.Message.t +=
| LookupClient of client_id | LookupClient of client_id
| ListIssues | ListIssues
| Reminder of forgejo_issue_data | Reminder of forgejo_issue_data
| InternalFailure of string | InternalFailure of (MatrixRoom.t * string)
let forgejo_issues issues = issues |> List.map (fun r -> Reminder r) let forgejo_issues issues = issues |> List.map (fun r -> Reminder r)
let internal_failure reason = InternalFailure reason let internal_failure matrix_room reason = InternalFailure (matrix_room, reason)

2
pam/lib/issuelib.ml
View file

@ -82,7 +82,7 @@ module Private = struct
| None, _ -> Error [%string "Can't parse numbers from string hour: h=%{h}|m=%{m}|"] | None, _ -> Error [%string "Can't parse numbers from string hour: h=%{h}|m=%{m}|"]
| _, None -> Error [%string "Can't parse numbers from string minute: h=%{h}|m=%{m}|"] | _, None -> Error [%string "Can't parse numbers from string minute: h=%{h}|m=%{m}|"]
end end
| _ -> Error [%string "Malformed time: %{str}"]) | _ -> Error [%string "Malformed time: |%{str}|%{date_str}|"])
end end
open Private open Private