Source file acti.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                                          *)
(*                                                                               *)
(*********************************************************************************)

(** Posting activities *)

module AP = Activitypub
module Log = AP.Log

module AS = Rdf.Activitypub

type AP.E.error +=
| Accept_no_actor of Iri.t (** When an Accept activity is POSTed without an actor object *)

let () = AP.E.register_string_of_error
  (function Accept_no_actor iri ->
       let msg = Printf.sprintf "Accepting %s: no actor to send to"
         (Iri.to_string iri)
       in
       Some msg
   | _ -> None
  )

type post_result = (Iri.t option, AP.E.error) result Lwt.t

type audience_post_fun = ?to_:Iri.t list ->
    ?bto:Iri.t list ->
    ?cc:Iri.t list ->
    ?bcc:Iri.t list ->
    ?audience:Iri.t ->
    ?public:bool ->
    unit -> post_result

type accept_fun = AP.Types.activity -> post_result
type announce_fun = Iri.t -> audience_post_fun
type create_fun = Rdf.Graph.graph -> Rdf.Term.term -> ?in_reply_to:Iri.t list -> audience_post_fun
type delete_fun = Iri.t -> post_result
type dislike_fun = Iri.t -> post_result
type follow_fun = Iri.t -> post_result
type like_fun = Iri.t -> post_result
type undo_fun = Iri.t -> post_result
type update_fun = Iri.t -> Rdf.Graph.graph -> post_result

(** This is the signature of the module we get after applying the
  {!Make} functor on an {!Object.T}: functions to POST activities, using
  module [O] to act as a given actor. *)
module type T = sig
    module O : Object.T
    val accept : accept_fun
    val announce : announce_fun
    val create : create_fun
    val delete : delete_fun
    val dislike : dislike_fun
    val follow : follow_fun
    val like : like_fun
    val undo : undo_fun
    val update : update_fun
  end

module Make (O:Object.T) : T = struct
    module O = O
    let actor () =
      let a = O.of_iri O.actor_iri in
      let%lwt () = a#dereference in
      Lwt.return a#as_actor

    let outbox actor =
      let%lwt () = actor#dereference in
      Lwt.return actor#outbox

    let post_activity ~actor g root =
      let%lwt ob = outbox actor in
      Log.debug (fun m -> m "Posting activity to %a:\n%s" Iri.pp ob#iri (Rdf.Nq.graph_to_string g));
      ( (* add published date if not present for root *)
       match Rdf.Graph.literal_objects_of g ~sub:root ~pred:AS.published with
       | _ :: _ -> ()
       | [] ->
           let d = Rdf.Term.term_of_datetime () in
           g.add_triple ~sub:root ~pred:AS.published ~obj:d
      );
      List.iter g.rem_triple_t (g.find ~sub:root ~pred:AS.actor ());
      g.add_triple ~sub:root ~pred:AS.actor ~obj:actor#id ;
      O.post ob#iri g

    let accept obj =
      Log.debug (fun m -> m "Acti.accept iri=%a" Iri.pp obj#iri);
      let%lwt () = obj#dereference in
      match obj#actor with
      | None -> Lwt.return_error (Accept_no_actor obj#iri)
      | Some to_ ->
          let to_ = AP.Types.iri_of_lo to_ in
          let%lwt actor = actor () in
          let g = Rdf.Graph.open_graph (Iri.of_string "") in
          let sub = Rdf.Term.blank_ (g.new_blank_id()) in
          g.add_triple ~sub ~pred:Rdf.Rdf_.type_ ~obj:(Rdf.Term.Iri AS.c_Accept) ;
          g.add_triple ~sub ~pred:AS.actor ~obj:actor#id ;
          g.add_triple ~sub ~pred:AS.object_ ~obj:(Rdf.Term.Iri obj#iri) ;
          g.add_triple ~sub ~pred:AS.to_ ~obj:(Rdf.Term.Iri to_) ;
          post_activity ~actor g sub

    let announce iri ?(to_=[]) ?(bto=[]) ?(cc=[]) ?(bcc=[]) ?audience ?(public=true) () =
      let%lwt actor = actor () in
      let g = Rdf.Graph.open_graph (Iri.of_string "") in
      let sub = Rdf.Term.blank_ (g.new_blank_id()) in
      g.add_triple ~sub ~pred:Rdf.Rdf_.type_ ~obj:(Rdf.Term.Iri AS.c_Announce) ;
      g.add_triple ~sub ~pred:AS.actor ~obj:actor#id ;
      g.add_triple ~sub ~pred:AS.object_ ~obj:(Rdf.Term.Iri iri);
      let add pred iri = g.add_triple ~sub ~pred ~obj:(Rdf.Term.Iri iri) in
      if public then add AS.cc AS.c_Public ;
      List.iter (add AS.to_) to_ ;
      List.iter (add AS.bto) bto ;
      List.iter (add AS.cc) cc ;
      List.iter (add AS.bcc) bcc ;
      Option.iter (add AS.audience) audience ;
      post_activity ~actor g sub

    let create g root ?(in_reply_to=[]) ?(to_=[]) ?(bto=[]) ?(cc=[]) ?(bcc=[]) ?audience ?(public=true) () =
      let%lwt actor = actor () in
      let g = g.Rdf.Graph.copy () in
      let sub = Rdf.Term.blank_ (g.new_blank_id()) in
      g.add_triple ~sub ~pred:Rdf.Rdf_.type_ ~obj:(Rdf.Term.Iri AS.c_Create) ;
      g.add_triple ~sub ~pred:AS.actor ~obj:actor#id ;
      g.add_triple ~sub ~pred:AS.object_ ~obj:root ;
      let add_both pred obj_iri =
        let obj = Rdf.Term.Iri obj_iri in
        g.add_triple ~sub ~pred ~obj;
        g.add_triple ~sub:root ~pred ~obj;
      in
      if public then add_both AS.cc AS.c_Public ;
      List.iter (add_both AS.to_) to_ ;
      List.iter (add_both AS.bto) bto ;
      List.iter (add_both AS.cc) cc ;
      List.iter (add_both AS.bcc) bcc ;
      Option.iter (add_both AS.audience) audience ;
      List.iter (fun iri -> g.add_triple ~sub:root ~pred:AS.inReplyTo ~obj:(Rdf.Term.Iri iri)) in_reply_to ;
      let published =
        match Rdf.Graph.literal_objects_of g ~sub:root ~pred:AS.published with
        | t :: _ -> Rdf.Term.Literal t
        | [] ->
            let d = Rdf.Term.term_of_datetime () in
            g.add_triple ~sub:root ~pred:AS.published ~obj:d;
            d
      in
      g.add_triple ~sub ~pred:AS.published ~obj:published ;
      post_activity ~actor g sub

    let delete iri =
      let%lwt actor = actor () in
      let g = Rdf.Graph.open_graph (Iri.of_string "") in
      let sub = Rdf.Term.blank_ (g.new_blank_id()) in
      g.add_triple ~sub ~pred:Rdf.Rdf_.type_ ~obj:(Rdf.Term.Iri AS.c_Delete) ;
      g.add_triple ~sub ~pred:AS.actor ~obj:actor#id ;
      g.add_triple ~sub ~pred:AS.object_ ~obj:(Rdf.Term.Iri iri) ;
      post_activity ~actor g sub

    let dislike iri =
      let%lwt actor = actor () in
      let g = Rdf.Graph.open_graph (Iri.of_string "") in
      let sub = Rdf.Term.blank_ (g.new_blank_id()) in
      g.add_triple ~sub ~pred:Rdf.Rdf_.type_ ~obj:(Rdf.Term.Iri AS.c_Dislike) ;
      g.add_triple ~sub ~pred:AS.actor ~obj:actor#id ;
      g.add_triple ~sub ~pred:AS.object_ ~obj:(Rdf.Term.Iri iri) ;
      post_activity ~actor g sub

    let follow iri =
      let%lwt actor = actor () in
      let g = Rdf.Graph.open_graph (Iri.of_string "") in
      let sub = Rdf.Term.blank_ (g.new_blank_id()) in
      g.add_triple ~sub ~pred:Rdf.Rdf_.type_ ~obj:(Rdf.Term.Iri AS.c_Follow) ;
      g.add_triple ~sub ~pred:AS.actor ~obj:actor#id ;
      g.add_triple ~sub ~pred:AS.object_ ~obj:(Rdf.Term.Iri iri) ;
      post_activity ~actor g sub

    let like iri =
      let%lwt actor = actor () in
      let g = Rdf.Graph.open_graph (Iri.of_string "") in
      let sub = Rdf.Term.blank_ (g.new_blank_id()) in
      g.add_triple ~sub ~pred:Rdf.Rdf_.type_ ~obj:(Rdf.Term.Iri AS.c_Like) ;
      g.add_triple ~sub ~pred:AS.actor ~obj:actor#id ;
      g.add_triple ~sub ~pred:AS.object_ ~obj:(Rdf.Term.Iri iri) ;
      post_activity ~actor g sub

    let undo iri =
      let%lwt actor = actor () in
      let g = Rdf.Graph.open_graph (Iri.of_string "") in
      let sub = Rdf.Term.blank_ (g.new_blank_id()) in
      g.add_triple ~sub ~pred:Rdf.Rdf_.type_ ~obj:(Rdf.Term.Iri AS.c_Undo) ;
      g.add_triple ~sub ~pred:AS.actor ~obj:actor#id ;
      g.add_triple ~sub ~pred:AS.object_ ~obj:(Rdf.Term.Iri iri) ;
      post_activity ~actor g sub

    let update iri g =
      let%lwt actor = actor () in
      let g = g.Rdf.Graph.copy () in
      let sub = Rdf.Term.blank_ (g.new_blank_id()) in
      g.add_triple ~sub ~pred:Rdf.Rdf_.type_ ~obj:(Rdf.Term.Iri AS.c_Update) ;
      g.add_triple ~sub ~pred:AS.actor ~obj:actor#id ;
      g.add_triple ~sub ~pred:AS.object_ ~obj:(Rdf.Term.Iri iri) ;
      post_activity ~actor g sub
  end