Source file main.ml

(*********************************************************************************)
(*                OCaml-ActivityPub                                              *)
(*                                                                               *)
(*    Copyright (C) 2023-2024 INRIA All rights reserved.                         *)
(*    Author: Maxence Guesdon, INRIA Saclay                                      *)
(*                                                                               *)
(*    This program is free software; you can redistribute it and/or modify       *)
(*    it under the terms of the GNU Lesser General Public License version        *)
(*    3 as published by the Free Software Foundation.                            *)
(*                                                                               *)
(*    This program is distributed in the hope that it will be useful,            *)
(*    but WITHOUT ANY WARRANTY; without even the implied warranty of             *)
(*    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the              *)
(*    GNU General Public License for more details.                               *)
(*                                                                               *)
(*    You should have received a copy of the GNU General Public License          *)
(*    along with this program; if not, write to the Free Software                *)
(*    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA                   *)
(*    02111-1307  USA                                                            *)
(*                                                                               *)
(*    Contact: maxence.guesdon@inria.fr                                          *)
(*                                                                               *)
(*********************************************************************************)

(** Creating clients. *)

(** This module allows to create client programs, handling multiple actors.
  It installs a {!Logs.reporter}.
  Command line options can be added. *)

(**/**)

let lwt_reporter () =
  (* beware to set style before defining the lwt_reporter, or style
     will not be taken into account *)
  Fmt_tty.setup_std_outputs ();
  let buf_fmt ~like =
    let b = Buffer.create 512 in
    Fmt.with_buffer ~like b,
    fun () -> let m = Buffer.contents b in Buffer.reset b; m
  in
  let app, app_flush = buf_fmt ~like:Fmt.stdout in
  let dst, dst_flush = buf_fmt ~like:Fmt.stderr in
  let reporter = Logs_fmt.reporter ~app ~dst () in
  let report src level ~over k msgf =
    let k () =
      let write () = match level with
        | Logs.App -> Lwt_io.write Lwt_io.stdout (app_flush ())
        | _ -> Lwt_io.write Lwt_io.stderr (dst_flush ())
      in
      let unblock () = over (); Lwt.return_unit in
      Lwt.finalize write unblock |> Lwt.ignore_result;
      k ()
    in
    reporter.Logs.report src level ~over:(fun () -> ()) k msgf;
  in
  { Logs.report = report }

let install_log_reporter () = Logs.set_reporter (lwt_reporter ())

(**/**)

module AP = Activitypub

(**/**)
let conf_file = ref "conf.json"
let init_conf = ref false

let base_options = [
  "-c", Arg.Set_string conf_file, "<file> read configuration from <file>" ;
  "--init-conf", Arg.Set init_conf, " create configuration file if is does not exists" ;
]

let default_usage = Printf.sprintf
  "Usage: %s [options] <args>\nwhere options are:"
    (Filename.basename Sys.argv.(0))
(**/**)

(** [run f] will parse command line then call [f].
  [-c] and [--init-conf] options are already defined, but more can be
  added using the [~options] argument. [-c] specifies the configuration
  file to use (default is ["conf.json"]. [--init-conf] will write
  a default configuration file if it is not present.
  The [usage] optional arugment can be used to replace the default usage message.

  [f] is called with the configuration content, the map (IRI -> {!Actor.T})
  built from the configuration and the anonymous command line arguments.

  The configuration file contains a list of actors, and must have the following form:
  {@json[{
  actors: {
    "https://my-server.bar/actors/alice": {
      jsonld_cache_dir: "jsonld-cache",
      cache_dir: null,
      token: "alice/jAB7HO7+BO/fPACKtT6xfKulEDmBH+gHQybHyg0dDM0=",
      media_post_iri: "https://my-favorite-media-host.foo/"
    },
    "https://another-server.gee/actors/bob": {
      ...
    },
    ...
}]}
*)
let run ?(usage=default_usage) ?(options=[]) f =
  install_log_reporter ();
  let options = base_options @ options in
  let args = ref [] in
  try
    Arg.parse options (fun s -> args := s :: !args) usage ;
    let conf =
      let o = Ocf.option Conf.t_wrapper Conf.default_t in
      let g = Ocf.as_group o in
      let conf_file_exists = Sys.file_exists !conf_file in
      Ocf.from_file ~fail_if_not_exist:(not !init_conf) g !conf_file ;
      let c = Ocf.get o in
      if !init_conf && not conf_file_exists then
        (
         Ocf.to_file g !conf_file ;
         AP.Log.info (fun m -> m "Configuration file generated into %s" !conf_file);
         exit 0
        )
      else
        c
    in
    Lwt_main.run
      (
       let map iri actor acc =
         let%lwt acc = acc in
         let%lwt http = Http.mk_http iri actor in
         let module H = struct
           let conf = conf
           let actor_conf = actor
           let actor_iri = iri
           include (val http)
         end
         in
         let module O = Object.Make (H) in
         let module Acti = Acti.Make(O) in
         let module A = Actor.Make (Acti) in
         let acc = Iri.Map.add iri (module A : Actor.T) acc in
         Lwt.return acc
       in
       let%lwt actors = Iri.Map.fold map conf.actors (Lwt.return Iri.Map.empty) in
       f conf actors (List.rev !args)
      )
  with
  | Failure msg | Sys_error msg ->
      AP.Log.err (fun m -> m "%s" msg);
      exit 1