pam

pam/bin/api.ml

@@ -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}"]

pam/bin/config.ml

@@ -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} *)
+  let repos = Otoml.find conf (Otoml.get_array (Otoml.get_array Otoml.get_string)) ["pam"; "repos"]
-  (mq_url, mq_user, mq_password, base64_creds)
+  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})

pam/bin/datatypes.ml

@@ -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

pam/bin/httpclient.ml

@@ -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
+let issue_of_json (m_room: Datatypes.MatrixRoom.t) (json): Datatypes.reminder option =
-  | {due_date=None; _} -> None
+  let open Yojson.Safe.Util in
-  | {url=url; title=title; due_date=Some due_date; body=_} -> Some {url=url; title=title; due_date=due_date}
+  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 urls =
-  let headers =
+    repos
-    Api.headers base64password
+    |> List.map (fun {forgejo_id; base64_password; matrix_room} ->
-    |> List.map (fun (k, v) -> (k, Py.String.of_string v))
+        (matrix_room, {url=forgejo_url forgejo_id |> Py.String.of_string; headers=make_headers base64_password}))
-    |> Py.Dict.of_bindings_string in
+    |> StringMap.of_list
+  in
+  {requests=requests; repos=urls}
 
-  {requests=requests; url=url; headers=headers}
+let make_get_request {requests; repos} =
-
-let make_get_request {requests; url; headers} =
   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
-  Api.issues_of_json jsontext
+      let matrix_room = Datatypes.MatrixRoom.make m_room_string in
-  |> Result.map (Datatypes.forgejo_issues % List.filter_map reminder_of_issue)
+      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 []

pam/bin/main.ml

@@ -6,18 +6,17 @@ open Utils
 let _MQ_CLIENT = "mq_client"
 let _HTTP_CLIENT = "http_client"
 
-let http_client base64password =
+let http_client (repos: Config.repo_data list) =
-  let http_actor = Httpclient.init base64password in
+  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
+        Httpclient.make_get_request http_actor
-        let msg = result_unpack reminders
+        |> List.map (Result.fold ~ok:identity ~error:identity)
-        in
+        |> List.iter (Riot.send_by_name ~name:_MQ_CLIENT)
-        Riot.send_by_name ~name:_MQ_CLIENT msg 
       | 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 main (config: Config.config) =
-  let http_client_pid = spawn (fun () -> http_client base64_creds) in  
+  let http_client_pid = spawn (fun () -> http_client config.repos) in  
-  let mq_client_pid = spawn (fun () -> Lwt_main.run (mq_client (mq_url, mq_user, mq_password) http_client_pid)) 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
+  let config = Config.configuration () |> Result.fold ~error:exit2 ~ok:identity in
-  Riot.run (fun () -> main (mq_url, mq_user, mq_password, base64_creds))
+  Riot.run (fun () -> main config)

pam/bin/utils.ml

@@ -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)