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

pam

Browse source
This commit is contained in:
Benedetta 2024-04-02 14:38:00 +02:00
parent e2812dafd8
commit b355e98bd3
6 changed files with 96 additions and 78 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

36
pam/bin/api.ml
View file

@ -1,36 +0,0 @@
open Yojson.Safe
let url = "https://bugs.lezzo.org/api/v1/repos/bparodi/Documenti/issues?state=open&type=issues"
let headers base64password =
[("accept", "application/json");
("authorization", [%string "Basic %{base64password}"])]
type issue = {
url: string;
title: string;
body: string;
due_date: string option;
}
and issues = issue list
let issue_of_json json =
let open Yojson.Safe.Util in
{
url = json |> member "url" |> to_string;
title = json |> member "title" |> to_string;
body = json |> member "body" |> to_string;
due_date = json |> member "due_date" |> to_option to_string;
}
let string_of_issue issue =
let due_date_str = match issue.due_date with
| Some date -> date
| None -> ""
in
[%string {|{ url="%{issue.url}"; title="%{issue.title}"; body = "%{issue.body}"; due_date=%{due_date_str} }|}]
let issues_of_json json_str =
let open Yojson.Safe.Util in
try json_str |> from_string |> to_list |> List.map issue_of_json |> Result.ok
with | Yojson.Json_error msg -> Error [%string "JSON parsing error: %{msg}"]

16
pam/bin/config.ml
View file

@ -1,8 +1,18 @@
type repo_data = {forgejo_id: string; base64_password: string; matrix_room: string}
type config = {mq_url: string; mq_user: string; mq_password: string; repos: repo_data list}
let configuration () =
let conf = Otoml.Parser.from_file "/etc/lanonna.toml" in
let mq_url = Otoml.find conf Otoml.get_string ["pam"; "mq_url"] in
let mq_user = Otoml.find conf Otoml.get_string ["pam"; "mq_user"] in
let mq_password = Otoml.find conf Otoml.get_string ["pam"; "mq_password"] in
let base64_creds = Otoml.find conf Otoml.get_string ["pam"; "forgejo_base64"] in
(* config_file {mq_url = mq_url; mq_user = mq_user; mq_password = mq_password; base64_creds = base64_creds} *)
(mq_url, mq_user, mq_password, base64_creds)
let repos = Otoml.find conf (Otoml.get_array (Otoml.get_array Otoml.get_string)) ["pam"; "repos"]
in
repos
|> List.fold_left (fun accum elem ->
match (accum, elem) with
| (Error e, _) -> Error e
| (Ok accum, id::psw::room::[]) -> {forgejo_id=id; base64_password=psw; matrix_room=room}::accum |> Result.ok
| (_, _) -> "Can't parse the list of repos. The format must be: [[owner/repo, base64_password, matrix_room], [...]]" |> Result.error
) (Ok [])
|> Result.map (fun repo_data -> {mq_url=mq_url; mq_user=mq_user; mq_password=mq_password; repos=repo_data})

12
pam/bin/datatypes.ml
View file

@ -1,11 +1,19 @@
type client_id = | MqClient | HttpClient
module MatrixRoom = struct
type t = string
let make str = str
end
type reminder = { (* from an issue in forgejo get a reminder *)
url: string;
title: string;
due_date: string ;
body: string;
matrix_target: MatrixRoom.t
}
type client_id = | MqClient | HttpClient
type Riot.Message.t +=
| RegisterClient of (client_id * Riot.Pid.t)
| LookupClient of client_id

80
pam/bin/httpclient.ml
View file

@ -1,31 +1,67 @@
open Pyops
open Pytypes
open Batteries
open Yojson.Safe
open Config
open Utils
type http_actor = {requests: pyobject; url: pyobject; headers: pyobject}
let forgejo_url repo_id = [%string
"https://salsa.lezzo.org/api/v1/repos/%{repo_id}/issues?state=open&type=issues"]
let reminder_of_issue : Api.issue -> Datatypes.reminder option = function
| {due_date=None; _} -> None
| {url=url; title=title; due_date=Some due_date; body=_} -> Some {url=url; title=title; due_date=due_date}
let issue_of_json (m_room: Datatypes.MatrixRoom.t) (json): Datatypes.reminder option =
let open Yojson.Safe.Util in
let due_date = json |> member "due_date" |> to_option to_string in
match due_date with
| None -> None
| Some due_date ->
let record: Datatypes.reminder = {
url = json |> member "url" |> to_string;
title = json |> member "title" |> to_string;
body = json |> member "body" |> to_string;
matrix_target = m_room;
due_date = due_date
}
in Some record
let init base64password =
let issues_of_json matrix_room json_str =
let open Yojson.Safe.Util in
try json_str |> from_string |> to_list |> List.map (issue_of_json matrix_room) |> List.filter_map identity |> Result.ok
with | Yojson.Json_error msg -> Error [%string "JSON parsing error: %{msg}"]
type repo_pytuple = {url: pyobject; headers: pyobject}
type http_actor = {requests: pyobject; repos: repo_pytuple StringMap.t}
let make_headers base64_password =
let headers =
[("accept", "application/json");
("authorization", [%string "Basic %{base64_password}"])] in
headers
|> List.map (fun (k, v) -> (k, Py.String.of_string v))
|> Py.Dict.of_bindings_string
let init (repos: Config.repo_data list) =
let _ = Py.initialize () in
let requests = Py.import "requests" in
let url = Py.String.of_string Api.url in
let headers =
Api.headers base64password
|> List.map (fun (k, v) -> (k, Py.String.of_string v))
|> Py.Dict.of_bindings_string in
{requests=requests; url=url; headers=headers}
let make_get_request {requests; url; headers} =
let get = Py.Module.get_function_with_keywords requests "get" in
let resp = get [|url|] [("headers", headers)] in
let jsontext =
resp.@$("text")
|> Py.String.to_string
let urls =
repos
|> List.map (fun {forgejo_id; base64_password; matrix_room} ->
(matrix_room, {url=forgejo_url forgejo_id |> Py.String.of_string; headers=make_headers base64_password}))
|> StringMap.of_list
in
Api.issues_of_json jsontext
|> Result.map (Datatypes.forgejo_issues % List.filter_map reminder_of_issue)
|> Result.map_error Datatypes.forgejo_error (*TODO: maybe not really a forgejo error, more like internal *)
{requests=requests; repos=urls}
let make_get_request {requests; repos} =
let get = Py.Module.get_function_with_keywords requests "get" in
let fold_fn = (fun m_room_string {url; headers} acc ->
let resp = get [|url|] [("headers", headers)] in
let jsontext =
resp.@$("text")
|> Py.String.to_string
in
let matrix_room = Datatypes.MatrixRoom.make m_room_string in
let value =
issues_of_json matrix_room jsontext
|> Result.map Datatypes.forgejo_issues
|> Result.map_error Datatypes.forgejo_error (*TODO: maybe not really a forgejo error, more like internal *)
in value::acc)
in StringMap.fold fold_fn repos []

24
pam/bin/main.ml
View file

@ -6,18 +6,17 @@ open Utils
let _MQ_CLIENT = "mq_client"
let _HTTP_CLIENT = "http_client"
let http_client base64password =
let http_actor = Httpclient.init base64password in
let http_client (repos: Config.repo_data list) =
let http_actor = Httpclient.init repos in
let _ = print_endline "Initialized http client" in
let rec loop () =
let _ =
match Riot.receive () with
| ListIssues ->
let reminders = Httpclient.make_get_request http_actor in
let msg = result_unpack reminders
in
Riot.send_by_name ~name:_MQ_CLIENT msg
Httpclient.make_get_request http_actor
|> List.map (Result.fold ~ok:identity ~error:identity)
|> List.iter (Riot.send_by_name ~name:_MQ_CLIENT)
| m -> unhandled m
in
loop ()
@ -25,7 +24,7 @@ let http_client base64password =
let mq_client (mq_url, mq_user, mq_password) consumer =
let pprint rem =
[%string "%{r.title}"]
[%string "%{rem.title}|%{rem.matrix_target}"]
in
let call_consumer pid { Amqp_client_lwt.Message.message = (_content, body); _ } =
@ -49,15 +48,14 @@ let mq_client (mq_url, mq_user, mq_password) consumer =
Mq.mq_publish_all mq rems
| m -> unhandled m
with | Riot.Receive_timeout -> Lwt.return_unit
in
loop ()
in
loop ()
let main (mq_url, mq_user, mq_password, base64_creds) =
let http_client_pid = spawn (fun () -> http_client base64_creds) in
let mq_client_pid = spawn (fun () -> Lwt_main.run (mq_client (mq_url, mq_user, mq_password) http_client_pid)) in
let main (config: Config.config) =
let http_client_pid = spawn (fun () -> http_client config.repos) in
let mq_client_pid = spawn (fun () -> Lwt_main.run (mq_client (config.mq_url, config.mq_user, config.mq_password) http_client_pid)) in
let _ = Riot.register _HTTP_CLIENT http_client_pid in
let _ = Riot.register _MQ_CLIENT mq_client_pid
in
@ -71,5 +69,5 @@ let main (mq_url, mq_user, mq_password, base64_creds) =
let () =
let (mq_url, mq_user, mq_password, base64_creds) = Config.configuration () in
Riot.run (fun () -> main (mq_url, mq_user, mq_password, base64_creds))
let config = Config.configuration () |> Result.fold ~error:exit2 ~ok:identity in
Riot.run (fun () -> main config)

6
pam/bin/utils.ml
View file

@ -13,8 +13,10 @@ let now () =
Printf.sprintf "%04d-%02d-%02d %02d:%02d:%02d"
year month day hour minute second
let result_unpack = function | Ok o -> o | Error e -> e
let unhandled m = [%string "Runtime failure: unhandled %{Batteries.dump m}"] |> print_endline; exit 2
let one_second = 1_000_000L
let exit2 msg = let _ = print_endline msg in exit 2
module StringMap = Map.Make (String)