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

(** Objects pre-implementation and graph convenient functions.

Convenient functions to implement {!Types.object_}s, including
a virtual {!class-object_} class performing queries on its internal
graph.
*)

(** {2 Errors} *)

type E.error +=
| Could_not_parse_graph of Iri.t * Ldp.Ct.t * string
| Http_error of Iri.t * Cohttp.Code.meth * string

let () = E.register_string_of_error
  (function
   | Could_not_parse_graph (iri, ct, msg) ->
       Some (Printf.sprintf "Could not parse graph from %s [%s]: %s"
        (Iri.to_string iri) (Ldp.Ct.to_string ct) msg)
   | Http_error (iri, meth, msg) ->
       Some (Printf.sprintf "HTTP %s %s: %s"
        (Cohttp.Code.string_of_method meth) (Iri.to_string iri) msg)
   | _ -> None
  )

(** {2 Content-types and mime-types} *)

(** [application/json] *)
let ct_json =
  match Ldp.Ct.of_string "application/json" with
  | Ok m -> m
  | Error _ -> assert false
let mime_json = Ldp.Ct.to_mime ct_json

(** [application/ld+json] *)
let ct_jsonld =
  match Ldp.Ct.of_string "application/ld+json" with
  | Ok m -> m
  | Error _ -> assert false
let mime_jsonld = Ldp.Ct.to_mime ct_jsonld

(** [application/activity+json] *)
let ct_activity_json =
  match Ldp.Ct.of_string "application/activity+json" with
  | Ok m -> m
  | Error _ -> assert false
let mime_activity_json = Ldp.Ct.to_mime ct_activity_json

(** List of accepted content-types: json-ld, activity_json, json, turtle, xmlrdf. *)
let accept_rdf_cts = Ldp.Ct.[ct_jsonld ; ct_turtle ; ct_xmlrdf ;  ct_json ; ct_activity_json ]

(** {2 JSON remote loader and parser} *)

(**/**)
let cache_dir_created = ref false
(**/**)

let jsonld_load_remote ?(loader=Rdf_json_ld.T.load_remote_curl) cache_dir =
  match cache_dir with
  | None ->
      (fun iri ->
         match Iri.Map.find_opt iri Jsonld_static.contexts with
         | Some str -> Lwt.return_ok str
         | None -> loader iri
      )
  | Some dir ->
      if not !cache_dir_created then
        (
         let _ = Sys.command (Printf.sprintf "mkdir -p %s" (Filename.quote dir)) in
         cache_dir_created := true
        );
      let f iri =
        match Iri.Map.find_opt iri Jsonld_static.contexts with
        | Some str -> Lwt.return_ok str
        | None ->
            let sha = Cryptokit.Hash.sha256 () in
            sha#add_string (Iri.to_string iri) ;
            let e = Cryptokit.Hexa.encode () in
            e#put_string sha#result ;
            let file = Filename.concat dir e#get_string in
            match%lwt Lwt_unix.file_exists file with
            | true ->
                let%lwt str = Lwt_io.(with_file ~mode:Input file read) in
                Lwt.return_ok str
            | false ->
                match%lwt loader iri with
                | Ok str ->
                    let%lwt () = Lwt_io.(with_file ~mode:Output file
                       (fun oc -> write oc str))
                    in
                    Lwt.return_ok str
                | x -> Lwt.return x
      in
      f

let jsonld_string_to_graph ?(g=Rdf.Graph.open_graph (Iri.of_string "")) options str =
  let json = Rdf_json_ld.J.from_string_exn str in
  let%lwt (ds,root) = Rdf_json_ld.Json_ld.to_rdf options json g in
  Rdf.Ds.merge_to_default ds;
  Lwt.return (ds.Rdf.Ds.default, root)

let jsonld_parser ?jsonld_loader cache_dir =
  let options = Rdf_json_ld.T.options (jsonld_load_remote ?loader:jsonld_loader cache_dir) in
  fun g ct body ->
    try%lwt
      let%lwt (g,root) = jsonld_string_to_graph ~g options body in
      Lwt.return_ok (g, root)
    with
    | Rdf_json_ld.T.Error e ->
        let msg = Rdf_json_ld.T.string_of_error e in
        Log.debug (fun m -> m "%s" body);
        let iri = g.Rdf.Graph.name () in
        Lwt.return_error (Could_not_parse_graph (iri, ct, msg))

let parse_graph ?jsonld_loader cache_dir =
  let jsonld_parser = jsonld_parser ?jsonld_loader cache_dir in
  fun iri ct body ->
    let g = Rdf.Graph.open_graph iri in
    match ct with
    | _ when Ldp.Ct.(has_mime ct mime_turtle) ->
        (try Rdf.Ttl.from_string g ~base:iri body; Lwt.return_ok (g, None)
         with Rdf.Ttl.Error e ->
             let msg = Rdf.Ttl.string_of_error e in
             Log.debug (fun m -> m "%s" body);
             Lwt.return_error (Could_not_parse_graph (iri, ct, msg))
        )
    | _ when Ldp.Ct.(has_mime ct mime_xmlrdf) ->
        (try Rdf.Xml.from_string g ~base:iri body; Lwt.return_ok (g, None)
         with Rdf.Xml.Invalid_rdf msg ->
             Log.debug (fun m -> m "%s" body);
             Lwt.return_error (Could_not_parse_graph (iri, ct, msg))
        )
    | _ when Ldp.Ct.(has_mime ct mime_jsonld)
             || Ldp.Ct.(has_mime ct mime_activity_json) ->
        (*prerr_endline ("parsing with jsonld:"^body);*)
        jsonld_parser g ct body
    | _ -> Lwt.return_error (Could_not_parse_graph (iri, ct, "No parser"))

(** A module with convenient function to query an object_'s graph. *)
module G = struct
    module G = Rdf.Graph
    let iri_obj_option g sub pred =
      match G.iri_objects_of g ~sub ~pred with
      | [] -> None
      | h :: _ -> Some h
    let first_iri_obj g sub pred =
      match iri_obj_option g sub pred with
      | None ->
          Log.warn (fun m -> m "%a has no %a"  Rdf.Term.pp_term sub Iri.pp pred);
          Iri.of_string ""
      | Some iri -> iri
    let first_int_obj g sub pred =
      let lits = G.literal_objects_of g ~sub ~pred in
      let p lit =
        match lit.Rdf.Term.lit_type with
        | Some t ->
            Iri.equal t Rdf.Rdf_.xsd_integer
              || Iri.equal t Rdf.Rdf_.xsd_int
        | None -> false
      in
      match List.filter p lits with
      | [] -> None
      | lit :: _ ->
          match int_of_string lit.lit_value with
          | n -> Some n
          | exception _ -> None

    let lit_is_string lit =
      match lit.Rdf.Term.lit_type with
      | None -> true
      | Some t ->
          Iri.equal t Rdf.Rdf_.xsd_string
            || Iri.equal t Rdf.Rdf_.dt_langString

    let lit_is_string_nolang lit =
      match lit.Rdf.Term.lit_language, lit.Rdf.Term.lit_type with
      | Some _, _ -> false
      | None, None -> true
      | None, Some t -> Iri.equal t Rdf.Rdf_.xsd_string

    let lit_is_datetime lit =
      match lit.Rdf.Term.lit_type with
      | None -> false
      | Some t -> Iri.equal t Rdf.Rdf_.xsd_datetime

    let first_string_obj g sub pred =
      let lits = G.literal_objects_of g ~sub ~pred in
      match List.filter lit_is_string lits with
      | [] -> None
      | lit :: _ -> Some lit.lit_value

    let first_string_nolang_obj g sub pred =
      let lits = G.literal_objects_of g ~sub ~pred in
      match List.filter lit_is_string_nolang lits with
      | [] -> None
      | lit :: _ -> Some lit.lit_value

    let lit_is_bool lit =
      match lit.Rdf.Term.lit_type with
      | None -> false
      | Some t -> Iri.equal t Rdf.Rdf_.xsd_boolean

    let first_bool_obj g sub pred =
      let lits = G.literal_objects_of g ~sub ~pred in
      match List.filter lit_is_bool lits with
      | [] -> None
      | lit :: _ -> Some (Rdf.Term.bool_of_literal lit)

    let first_ct_obj g sub pred =
      match first_string_obj g sub pred with
      | None -> None
      | Some str ->
          match Ldp.Ct.mime_of_string str with
          | Ok ct -> Some ct
          | _ -> None

    let first_datetime_obj g sub pred =
      let lits = G.literal_objects_of g ~sub ~pred in
      match List.filter lit_is_datetime lits with
      | [] -> None
      | lit :: _ ->
          match Rdf.Term.datetime_of_literal lit with
          | dt -> Some dt
          | exception _ -> None

    let string_list_obj g sub pred =
      let l = g.G.objects_of ~sub ~pred in
      let l = List.flatten (List.map (G.to_list g) l) in
      let l = G.only_literals l in
      let l = List.filter lit_is_string l in
      List.map (fun lit -> lit.Rdf.Term.lit_value) l

    let term_is_id = function
    |  Rdf.Term.Literal _ | Blank -> false
    | _ -> true

    let link_or_object_list create g sub pred =
      let objs = g.G.objects_of ~sub ~pred in
      List.fold_left
        (fun acc -> function
           | term when term_is_id term -> (create term) :: acc
           | _ -> acc)
        []
        objs

    let link_or_object_ordered_list create g sub pred =
      match g.G.find ~sub ~pred () with
      | [] -> []
      | (_,_,head) :: _ ->
          let l = G.to_list g head in
          let l = List.filter term_is_id l in
          List.map create l

    let link_or_object_option create g sub pred =
      let objs = List.filter term_is_id (g.G.objects_of ~sub ~pred) in
      match objs with
      | [] -> None
      | term :: _ -> Some (create term)

    let string_lang_map_obj g sub pred =
      let objs = G.literal_objects_of g ~sub ~pred in
      let f acc lit =
        match lit.Rdf.Term.lit_language with
        | Some lang -> Smap.add lang lit.lit_value acc
        | None -> acc
      in
      List.fold_left f Smap.empty objs
  end

(** {2 Implementations of objects} *)

(**/**)
module AS = Rdf.Activitystreams
(**/**)

let none_if_iri_only id g =
  match id, g with
  | _, None -> None
  | Rdf.Term.Iri iri, Some g ->
      if g.Rdf.Graph.exists ~sub:id () then
        let g2 = Utils.graph_keep_only_from
          ~keep:(fun _ -> true) g id
        in
        (Some g2)
      else
        None
  | _ -> g

(** Implementation of a link. *)
class link g id : Types.link =
  object(self)
    method id = id
    method height = G.first_int_obj g id AS.height
    method href = match G.iri_obj_option g id AS.href with
      | None -> G.first_iri_obj g id AS.url
      | Some x  -> x
    method hreflang = G.first_string_obj g id AS.hreflang
    method media_type = G.first_ct_obj g id AS.mediaType
    method name = G.first_string_obj g id AS.name
    method rel = G.string_list_obj g id AS.rel
    method width = G.first_int_obj g id AS.width
    method g = g
  end

(** A pre-implementation of an {!Types.object_}. Dereferencing and casting
  methods remain to be implemented. *)
class virtual object_  = fun ?g (id:Types.id) ->
    object(self)
      val mutable g = (g : Rdf.Graph.graph option)
      val mutable id = id
      method id = id
      method iri = match self#id with
      | Rdf.Term.Iri i -> i
      | id ->
            match self#url with
            | [] ->
                Log.warn (fun m -> m "Id of %a is not an IRI and no url found" Rdf.Term.pp_term id);
                Iri.of_string ""
            | li :: _ -> Types.iri_of_liri li

      method g = g
      method private g_ = match g with
        | Some g -> g
        | None ->
            Log.warn (fun m -> m "%a: no g, creating empty graph" Iri.pp self#iri);
            let iri = match id with Iri i -> i | _ -> Iri.of_string "" in
            Rdf.Graph.open_graph iri

      method is_empty =
        match self#g with
        | None -> true
        | Some g -> g.Rdf.Graph.find ~sub:id () = []

      method as_link  = new link self#g_ id

      method pp ppf () =
        Format.fprintf ppf "%a:@.%s"
          Rdf.Term.pp_term self#id
          (match g with None -> "no graph" | Some g -> Rdf.Ttl.to_string g)

      method private link_or_object term : [`L of Types.link | `O of Types.object_] =
        let g = self#g_ in
        match Rdf.Graph.types_of g term with
        | t :: _ when Iri.equal t AS.c_Link -> `L (new link g term)
        | _ ->  `O (self#new_object ?g:(none_if_iri_only term self#g) term)


      method private link_or_image term : [`L of Types.link | `I of Types.image] =
        let g = self#g_ in
        match Rdf.Graph.types_of g term with
        | t :: _ when Iri.equal t AS.c_Link -> `L (new link g term)
        | _ -> `I (self#new_image ?g:(none_if_iri_only term self#g) term)

      method private link_or_iri_option pred : [`L of Types.link | `I of Iri.t] option =
        let g = self#g_ in
        (*Log.debug (fun m -> m "#link_or_iri_option id=%a, pred=%a \n%s"
           Rdf.Term.pp_term id Iri.pp pred (Rdf.Nq.graph_to_string g));*)
        match g.Rdf.Graph.objects_of ~sub:id ~pred with
        | [] ->
            (*Log.debug (fun m -> m "No objects");*)
            None
        | term :: _ ->
            (*Log.debug (fun m -> m "term=%a" Rdf.Term.pp_term term);*)
            match Rdf.Graph.types_of g term with
            | t :: _ when Iri.equal t AS.c_Link -> Some (`L (new link g term))
            | _ ->
                match term with
                | Rdf.Term.Iri iri -> Some (`I iri)
                | _ -> None

      method private link_or_iri_list pred : [`L of Types.link | `I of Iri.t] list =
        let g = self#g_ in
        let objs = g.Rdf.Graph.objects_of ~sub:id ~pred in
        let f acc term =
            match Rdf.Graph.types_of g term with
            | t :: _ when Iri.equal t AS.c_Link -> (`L (new link g term)) :: acc
            | _ ->
                match term with
                | Rdf.Term.Iri iri -> (`I iri) :: acc
                | _ -> acc
        in
        List.fold_left f [] objs

      method type_ =
        let iri = G.first_iri_obj self#g_ id Rdf.Rdf_.type_ in
        (*assert (not (Iri.equal (Iri.of_string "") iri));*)
        iri

      method as_id = G.iri_obj_option self#g_ id AS.id
      method attachment = G.link_or_object_list self#link_or_object self#g_ id AS.attachment
      method attributed_to = G.link_or_object_option self#link_or_object self#g_ id AS.attributedTo
      method audience = G.link_or_object_option self#link_or_object self#g_ id AS.audience
      method likes = (None : Types.collection option) (* missing vocab iri ?
        Option.map (self#new_collection ?g)
          (G.iri_obj_option self#g_ id AS.???) *)
      method shares = (None : Types.collection option) (* missing vocab iri ?
        Option.map (self#new_collection ?g)
          (G.iri_obj_option self#g_ id AS.???) *)
      method content = G.first_string_nolang_obj self#g_ id AS.content
      method content_map = G.string_lang_map_obj self#g_ id AS.content
      method name = G.first_string_nolang_obj self#g_ id AS.name
      method name_map = G.string_lang_map_obj self#g_ id AS.name
      method end_time = G.first_datetime_obj self#g_ id AS.endTime
      method generator = G.link_or_object_option self#link_or_object self#g_ id AS.generator
      method icon = G.link_or_object_list self#link_or_image self#g_ id AS.icon
      method image = G.link_or_object_list self#link_or_image self#g_ id AS.image
      method in_reply_to = G.link_or_object_list self#link_or_object self#g_ id AS.inReplyTo
      method preview = G.link_or_object_option self#link_or_object self#g_ id AS.preview
      method published = G.first_datetime_obj self#g_ id AS.published
      method replies =
        Option.map (fun iri -> self#new_collection
           ?g:(none_if_iri_only (Rdf.Term.Iri iri) self#g) (Rdf.Term.Iri iri))
          (G.iri_obj_option self#g_ id AS.replies)
      method start_time = G.first_datetime_obj self#g_ id AS.startTime
      method summary = G.first_string_nolang_obj self#g_ id AS.summary
      method summary_map = G.string_lang_map_obj self#g_ id AS.summary
      method tag = G.link_or_object_list self#link_or_object self#g_ id AS.tag
      method updated = G.first_datetime_obj self#g_ id AS.updated
      method url = self#link_or_iri_list AS.url
      method to_ = G.link_or_object_list self#link_or_object self#g_ id AS.to_
      method bto = G.link_or_object_list self#link_or_object self#g_ id AS.bto
      method cc = G.link_or_object_list self#link_or_object self#g_ id AS.cc
      method bcc = G.link_or_object_list self#link_or_object self#g_ id AS.bcc
      method media_type = G.first_ct_obj self#g_ id AS.mediaType

        (** collection methods *)
      method total_items = Option.value ~default:0 (G.first_int_obj self#g_ id AS.totalItems)
      method current = self#link_or_iri_option AS.current
      method first = self#link_or_iri_option AS.first
      method last = self#link_or_iri_option AS.last
      method items =
        (*Log.debug (fun m -> m "graph of %a: %s" Iri.pp self#iri
           (match self#g with None -> "no graph" | Some g -> Rdf.Nq.graph_to_string g));*)
        let ordered = Iri.equal self#type_ AS.c_OrderedCollection
          || Iri.equal self#type_ AS.c_OrderedCollectionPage
        in
        match self#first with
        | None ->
            let f = if ordered
              then G.link_or_object_ordered_list
              else G.link_or_object_list
            in
            Lwt.return (Lwt_stream.of_list
             (f self#link_or_object self#g_ id AS.items))
        | Some li ->
            let next = ref (Some li) in
            let items = ref [] in
            let push_next_items () =
              match !next with
              | None -> Lwt.return_unit
              | Some x ->
                  let iri = match x with
                    | `L l -> l#href
                    | `I iri -> iri
                  in
                  Log.debug (fun m -> m "new_collection page %a" Iri.pp iri);
                  let page = self#new_collection_page (Rdf.Term.Iri iri) in
                  let%lwt () = page#dereference in
                  (*Log.debug (fun m -> m "page graph: %s"
                     (match page#g with None -> "no graph" | Some g -> Rdf.Ttl.to_string g));*)
                  let%lwt l = let%lwt st = page#items in Lwt_stream.to_list st in
                  items := l;
                  next := page#next;
                  Log.debug (fun m -> m "next = %s"
                     (match !next with
                      | None -> "None"
                      | Some (`L l) -> Iri.to_string l#href
                      | Some (`I iri) -> Iri.to_string iri
                     ));
                  Lwt.return_unit
            in
            let rec f () =
              match !items, !next with
              | h::q, _ -> items := q; Lwt.return_some h
              | [], None -> Lwt.return_none
              | [], Some li -> let%lwt () = push_next_items () in f ()
            in
            let st = Lwt_stream.from f in
            Lwt.return st

      (** collection_page methods *)
      method part_of = self#link_or_iri_option AS.partOf
      method next = self#link_or_iri_option AS.next
      method prev = self#link_or_iri_option AS.prev

        (** ordered_collection_page methods *)
      method start_index = G.first_int_obj self#g_ id AS.startIndex

      (** activity methods *)
      method actor = G.link_or_object_option self#link_or_object self#g_ id AS.actor
      method object_ = G.link_or_object_option
        (fun term -> self#new_object ?g:(none_if_iri_only term g) term) self#g_ id AS.object_
      method target = G.link_or_object_option self#link_or_object self#g_ id AS.target
      method origin = G.link_or_object_option self#link_or_object self#g_ id AS.origin
      method result = G.link_or_object_option self#link_or_object self#g_ id AS.result
      method instrument = G.link_or_object_list self#link_or_object self#g_ id AS.instrument

      method as_object = (self :> Types.object_)
      method as_collection = (self :> Types.collection)
      method as_ordered_collection = (self :> Types.ordered_collection)
      method as_collection_page = (self :> Types.collection_page)
      method as_ordered_collection_page = (self :> Types.ordered_collection_page)
      method as_activity = (self :> Types.activity)

      method virtual private new_object : ?g:Rdf.Graph.graph -> Types.id -> Types.object_
      method virtual private new_activity : ?g:Rdf.Graph.graph -> Types.id -> Types.activity
      method virtual private new_image : ?g:Rdf.Graph.graph -> Types.id -> Types.image
      method virtual private new_collection : ?g:Rdf.Graph.graph -> Types.id -> Types.collection
      method virtual private new_ordered_collection : ?g:Rdf.Graph.graph -> Types.id -> Types.ordered_collection
      method virtual private new_collection_page : ?g:Rdf.Graph.graph -> Types.id -> Types.collection_page
      method virtual private new_ordered_collection_page : ?g:Rdf.Graph.graph -> Types.id -> Types.ordered_collection_page

      method virtual dereference : unit Lwt.t

    end

(** [pp ppf o] pretty-prints the given [object_] to [ppf]. *)
let pp ppf o = o#pp ppf ()

(** {2 Convenient functions} *)

(** [graph_roots g] returns the list of root nodes, i.e. nodes which do
  not appear as object in edges of the graph. Some nodes are filtered
  out (blank nodes having a blank node as type, which are sent by Mastodon).
*)
let graph_roots =
  let q =
    [%sparql {| PREFIX  rdf:    <http://www.w3.org/1999/02/22-rdf-syntax-ns#>
     SELECT DISTINCT ?root
     { ?root ?p ?o
       MINUS { ?x ?y ?root }
     }
   |}]
  in
  fun g ->
    let ds = Rdf.Ds.simple_dataset g in
    let sols = Rdf.Sparql.select ~base:(g.name()) ds q in
    let roots = List.map (fun sol -> Rdf.Sparql.get_term sol "root") sols in
    (* remove roots having rdf:type with blank node as object. This is
       because servers like mastodon may send json-ld with missing contexts,
       giving _:foo rdf:type _:bar triples after expansion, which result
       in detecting more than one root. *)
    List.filter (fun sub ->
       match g.Rdf.Graph.objects_of ~sub ~pred:Rdf.Rdf_.type_ with
       | [Rdf.Term.Blank_ _] -> false
       | _ -> true)
      roots
let activity_types = Iri.Set.of_list
  Rdf.Activitystreams.[
    c_Accept ; c_Add ; c_Announce ; c_Arrive ;
    c_Block ; c_Create ; c_Delete ; c_Dislike ;
    c_Flag ; c_Follow ; c_Ignore ; c_Invite ;
    c_Join ; c_Leave ; c_Like ; c_Listen ;
    c_Move ; c_Offer ; c_Question ; c_Reject ;
    c_Read ; c_Remove ; c_TentativeReject ;
    c_TentativeAccept ; c_Travel ; c_Undo ;
    c_Update ; c_View ;
  ]

(** [is_activity typ] returns whether [typ] corresponds to an activity type.*)
let is_activity typ = Iri.Set.mem typ activity_types

(** [map_graph f g] returns a new graph with all triples mapped with [f].
  [f] is also applied to the graph name (an IRI) to get the name of the new graph
  (as an IRI). *)
let map_graph f g =
  let triples = g.Rdf.Graph.find () in
  let g2 =
    let name = match f (Rdf.Term.Iri (g.name ())) with
      | Rdf.Term.Iri i -> i
      | _ -> g.name ()
    in
    Rdf.Graph.open_graph name
  in
  List.iter (fun (sub, pred, obj) ->
     let sub = f sub in
     let obj = f obj in
     g2.add_triple ~sub ~pred ~obj)
    triples;
  g2

(** For each relation [to_], [bto], [cc], [bcc] and [audience] of [src],
  [copy_addresses ~src ~dst ~dstid] adds a triple in graph [dst] with
  [dstid] as subjet and the same predicates (to, cc, ...) and objects.
  Returns [true] if at least one address was copied in [dst] (but does
  not check if such a triple already existed).
*)
let copy_addresses ~src ~(dst:Rdf.Graph.graph) ~dstid =
  let copied_one = ref false in
  let copy pred = function
  | `O obj -> dst.add_triple ~sub:dstid ~pred ~obj:obj#id; copied_one:=true
  | `L link -> dst.add_triple ~sub:dstid ~pred ~obj:(Rdf.Term.Iri link#href); copied_one:=true
  in
  List.iter (copy AS.to_) src#to_ ;
  List.iter (copy AS.bto) src#bto ;
  List.iter (copy AS.cc) src#cc ;
  List.iter (copy AS.bcc) src#bcc ;
  Option.iter (copy AS.audience) src#audience;
  !copied_one

(** [remove_addresses g sub] removes all triples of [g] with subject [sub]
  and [to], [bto], [cc], [bcc] or [audience] predicate. *)
let remove_addresses (g:Rdf.Graph.graph) sub =
  List.iter (fun pred ->
    List.iter g.rem_triple_t (g.find ~sub ~pred ()))
    [ AS.to_ ; AS.bto ; AS.cc ; AS.bcc ; AS.audience ]

(** [id_of_link_or_object (`L link)] returns [Iri link#href].
  [id_of_link_or_object (`O obj)] returns [obj#id]. *)
let id_of_link_or_object = function
| `L link -> Rdf.Term.Iri link#href
| `O o -> o#id

(** [remove_bto_bcc g] removes all triples having [bto] and [bcc] as predicate. *)
let remove_bto_bcc (g:Rdf.Graph.graph) =
  List.iter g.rem_triple_t (g.find ~pred:AS.bto());
  List.iter g.rem_triple_t (g.find ~pred:AS.bcc())