pam

pam/bin/api.ml

@@ -0,0 +1,37 @@
+open Yojson.Safe
+
+let url = "https://bugs.lezzo.org/api/v1/repos/bparodi/Documenti/issues?state=open&type=issues"
+
+let headers =
+  let base64password = Datatypes.forgejo in
+  [("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

@@ -0,0 +1,3 @@
+let configuration () =
+  let conf = Otoml.Parser.from_file "/etc/lanonna.toml" in
+  Otoml.find conf Otoml.get_string ["lanonna"; "mq_url"]

pam/bin/datatypes.ml

@@ -0,0 +1,19 @@
+
+type reminder = { (* from an issue in forgejo get a reminder *)
+  url: string;
+  title: string;
+  due_date: string ;
+}
+
+type Riot.Message.t +=
+  | ReceivedFromMq of string
+  | WebReq 
+  | ForgejoIssues of reminder list
+  | ForgejoError of string
+  | InternalFailure of string
+
+let forgejo_issues lst = ForgejoIssues lst
+let forgejo_error reason = ForgejoError reason
+
+let of_reminder r =
+  [%string "%{r.title}"]

pam/bin/dune

@@ -0,0 +1,7 @@
+(executable
+ (public_name pam)
+ (name main)
+     (libraries riot amqp-client-lwt pyml yojson batteries otoml )
+ (preprocess
+  (pps lwt_ppx ppx_string  ))
+)

pam/bin/httpclient.ml

@@ -0,0 +1,31 @@
+open Pyops
+open Pytypes
+open Batteries
+
+type http_actor = {requests: pyobject; url: pyobject; headers: pyobject}
+
+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 init () =
+  let _ = Py.initialize () in
+  let requests = Py.import "requests" in
+  let url = Py.String.of_string Api.url in
+  let headers =
+    Api.headers
+    |> 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
+  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 *)

pam/bin/main.ml

@@ -0,0 +1,77 @@
+open Riot
+open Datatypes
+open Batteries
+open Util
+
+let http mq_pid =
+  let http_actor = Httpclient.init () in
+  let _ = print_endline "Initialized http client" in
+
+  let rec loop () =
+    let _ =
+      match Riot.receive () with
+      | WebReq ->
+        let _ = print_endline "Got webreq" in
+        let reminders = Httpclient.make_get_request http_actor in
+        let msg =
+          reminders
+          |> Result.map (fun f -> Batteries.dump f |> print_endline; f) 
+          |> result_unpack
+        in
+        Riot.send mq_pid msg 
+      | _ -> failwith "Unknown msg"
+    in
+    loop ()
+  in loop ()
+
+let rabbit consumer =
+  let%lwt mq = Mq.init consumer in
+
+  let rec loop () =
+    let%lwt _ = Lwt_unix.sleep 1.0 in
+    let _ =  
+      try%lwt
+        match Riot.receive ~after:1000L () with (* TODO: Somehow the 1000L doesn't work. Report it.*)
+        | ForgejoError err ->
+          let _ = print_endline [%string "Got error from Forgejo: %{err}"] in
+          Lwt.return (Mq.mq_publish mq err )
+        | ForgejoIssues reminders ->
+          let _ = [%string "Got reminders: %{Batteries.dump reminders}"] |> print_endline in
+          let rems = List.map of_reminder reminders in
+          Lwt.return (Mq.mq_publish_all mq rems)
+        | _ ->
+          failwith "Unhandled msg"
+      with | Riot.Receive_timeout -> failwith "dunno"
+
+    in
+    loop ()
+  in
+  loop ()
+
+let loop http_pid =
+  let rec loop_ () =
+    let _ = send http_pid WebReq in
+    let _ = sleep 60.0 in
+    loop_ ()
+  in
+  loop_()
+
+let main () =
+  let _own = self () in
+  let http = spawn (fun () -> http _own) in  (*TODO: nope*)
+  let _mq = spawn (fun () -> Lwt_main.run (rabbit http)) in
+  sleep 2.0
+  ;
+  send _mq (Datatypes.ForgejoIssues []);
+  let _ = spawn (fun () -> loop http) in
+  let _ = print_endline "Now looping"
+  in
+  let rec forever () = (* TODO: is there something better? Like monitoring processes ?*)
+    sleep 22.2; forever ()
+  in forever ()
+    
+
+
+let () =
+  Config.configuration () |> print_endline;
+  Riot.run main

pam/bin/mq.ml

@@ -0,0 +1,43 @@
+open Amqp_client_lwt
+
+let handler pid { Message.message = (_content, body); _ } =
+  Riot.send pid (Datatypes.ReceivedFromMq ("GOT RABBITs: "^body)) (*TODO: log*)
+
+let handle_consumer_exn _exn =
+  Lwt.return_unit (* TODO *)
+
+let no_routing_key = `Queue ""
+
+type rabbit_actor = {queue: Queue.t; channel: Channel.no_confirm Channel.t; connection: Connection.t}
+
+let init riot_consumer =
+  (* Init rabbitmq client *)
+  let%lwt connection = Amqp.Connection.connect ~credentials:Datatypes.CREDS ~id:"Pam" MQURL in (*TODO: Creds*)
+  let%lwt channel = Amqp.Connection.open_channel ~id:"Pam" Amqp.Channel.no_confirm connection in
+  let%lwt exchange = Amqp.Exchange.declare channel Exchange.direct_t "pam" in
+  (* let%lwt lanonna_exchange = Amqp.Exchange.declare channel Exchange.direct_t "lanonna" in *)
+  let%lwt queue = Amqp.Queue.declare channel "pam" in
+  let _ = Amqp.Queue.bind channel queue exchange no_routing_key in
+  (* Amqp.Queue.publish channel queue (Amqp.Message.make "My Message Payload") >>= function `Ok -> *)
+  let _ = print_endline "Initialized rabbitmq client" in
+
+  (* Establish consumer *)
+  let%lwt (_ampq_consumer, reader) = Amqp.Queue.consume ~no_ack:true ~id:"" channel queue in
+  let _ = Thread.spawn ~exn_handler:handle_consumer_exn (Thread.Pipe.iter_without_pushback reader ~f:(handler riot_consumer)) in
+  Lwt.return {queue=queue; channel=channel; connection=connection}
+
+let shutdown {queue=_queue; channel; connection} =
+  let ignore_exn = fun _ -> Lwt.return_unit in
+  let%lwt _ = Lwt.catch (fun () -> Amqp.Channel.close channel) ignore_exn in
+  let%lwt _ = Lwt.catch (fun () -> Amqp.Connection.close connection) ignore_exn in
+  Lwt.return_unit
+
+let mq_publish {queue=_; channel; connection=_} msg =
+  let%lwt _ =
+    Message.make msg
+    |> Exchange.publish channel Exchange.default  ~routing_key:"lanonna"
+  in Lwt.return_unit
+
+let rec mq_publish_all mq = function
+  | [] -> Lwt.return_unit
+  | r::rest -> let%lwt _ = mq_publish mq r in mq_publish_all mq rest

pam/bin/util.ml

@@ -0,0 +1,16 @@
+open Unix
+
+let now () =
+  let current_time = time () in
+  let human_time = localtime current_time in
+  let year = 1900 + human_time.tm_year in
+  let month = human_time.tm_mon + 1 in
+  let day = human_time.tm_mday in
+  let hour = human_time.tm_hour in
+  let minute = human_time.tm_min in
+  let second = human_time.tm_sec in
+
+  Printf.sprintf "%04d-%02d-%02d %02d:%02d:%02d"
+    year month day hour minute second
+
+let result_unpack = function | Ok o -> o | Error e -> e

pam/dune-project

@@ -0,0 +1,26 @@
+(lang dune 3.14)
+
+(name pam)
+
+(generate_opam_files true)
+
+(source
+ (github username/reponame))
+
+(authors "Author Name")
+
+(maintainers "Maintainer Name")
+
+(license LICENSE)
+
+(documentation https://url/to/documentation)
+
+(package
+ (name pam)
+ (synopsis "A short synopsis")
+ (description "A longer description")
+ (depends ocaml dune)
+ (tags
+  (topics "to describe" your project)))
+
+; See the complete stanza docs at https://dune.readthedocs.io/en/stable/dune-files.html#dune-project

pam/pam.opam

@@ -0,0 +1,31 @@
+# This file is generated by dune, edit dune-project instead
+opam-version: "2.0"
+synopsis: "A short synopsis"
+description: "A longer description"
+maintainer: ["Maintainer Name"]
+authors: ["Author Name"]
+license: "LICENSE"
+tags: ["topics" "to describe" "your" "project"]
+homepage: "https://github.com/username/reponame"
+doc: "https://url/to/documentation"
+bug-reports: "https://github.com/username/reponame/issues"
+depends: [
+  "ocaml"
+  "dune" {>= "3.14"}
+  "odoc" {with-doc}
+]
+build: [
+  ["dune" "subst"] {dev}
+  [
+    "dune"
+    "build"
+    "-p"
+    name
+    "-j"
+    jobs
+    "@install"
+    "@runtest" {with-test}
+    "@doc" {with-doc}
+  ]
+]
+dev-repo: "git+https://github.com/username/reponame.git"

pam/pyproject.toml

@@ -0,0 +1,15 @@
+[tool.poetry]
+name = "pam"
+version = "0.1.0"
+description = ""
+authors = ["me"]
+readme = "README.md"
+
+[tool.poetry.dependencies]
+python = "^3.11"
+pika = "^1.3.2"
+
+
+[build-system]
+requires = ["poetry-core"]
+build-backend = "poetry.core.masonry.api"

pam/test/dune

@@ -0,0 +1,2 @@
+(test
+ (name test_pam))