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

module AP = Activitypub
module Types = AP.Types
module Log = AP.Log
module O = AP.Object

module AS = Rdf.Activitypub

type dereferencer = ?actor:Types.actor -> Iri.t ->
    (Rdf.Graph.graph * Iri.t option, AP.E.error) result Lwt.t

type graph_kind = [`Local | `Foreign]

module type T = sig
    val conf : Conf.t
    module H : Ldp.Http.Http

    val is_local_iri : Iri.t -> bool
    val dir_sep : char
    val iri_of_dir : string -> Iri.t
    val objects_dir : string
    val foreign_objects_dir_of_actor_name : string -> string
    val public_collection_dir : string
    val media_root_dir : string option
    val media_path_of_iri : Iri.t -> string option
    val gen_media_iri : unit -> (Iri.t * string) option

    val init_local_collection : inline:bool -> ordered:bool -> public:bool ->
      ?owner:Iri.t -> string -> unit Lwt.t

    val http_query_headers : ?actor:Types.actor -> met:Cohttp.Code.meth ->
      ?body:string -> Iri.t -> Cohttp.Header.t option Lwt.t
    val httpget_headers : ?actor:Types.actor -> Iri.t -> Cohttp.Header.t option Lwt.t

    val jsonld_document_loader : ?actor:Types.actor ->  Iri.t -> (string, exn) result Lwt.t
    val graph_to_jsonld_string : ?actor:Types.actor -> Rdf.Graph.graph -> string
    val graph_root_to_jsonld_string : ?actor:Types.actor -> Rdf.Graph.graph -> Rdf.Term.term -> string

    val local_dereference : dereferencer
    val http_dereference : dereferencer
    val dereference : ?http:dereferencer -> local:dereferencer -> dereferencer
    class type o_ = object
        inherit Types.object_
        method private g_ : Rdf.Graph.graph
        method private new_object : ?g:Rdf.Graph.graph -> Types.id -> Types.object_
        method private new_collection : ?g:Rdf.Graph.graph -> Types.id -> Types.collection
        method private new_ordered_collection : ?g:Rdf.Graph.graph -> Types.id -> Types.ordered_collection
        method private new_image : ?g:Rdf.Graph.graph -> Types.id -> Types.image
        method private local_dereference : dereferencer
        method private http_dereference : dereferencer
        method as_object : Types.object_
        method as_collection : Types.collection
        method as_ordered_collection : Types.ordered_collection
        method as_collection_page : Types.collection_page
        method as_ordered_collection_page : Types.ordered_collection_page
        method as_activity : Types.activity
      end

    class o : ?http_deref:dereferencer -> local_deref:dereferencer ->
      ?actor:Types.actor -> ?g:Rdf.Graph.graph -> Types.id ->
        object
          inherit Types.ordered_collection_page
          inherit Types.activity
          inherit o_
        end
    class local_collection : string -> Iri.t ->
      object
        method is_public : bool
        method iri : Iri.t
        method graph_copy : Rdf.Graph.graph Lwt.t
        method add_item : ?unique:bool -> ?payload:(Iri.t * Rdf.Term.term) list ->
          Rdf.Term.term -> (unit, [`Msg of string]) result Lwt.t
        method remove_item : Rdf.Term.term -> (unit, [`Msg of string]) result Lwt.t
      end
    val store_local_graph : Rdf.Graph.graph -> Iri.t -> unit Lwt.t
    val store_foreign_graph : ?actor:AP.Types.actor -> Rdf.Graph.graph -> Iri.t -> unit Lwt.t
    val store : ?actor:AP.Types.actor -> ?prune:bool -> kind:graph_kind -> o_ -> unit Lwt.t

    val get : ?actor:Types.actor -> ?g:Rdf.Graph.graph -> Types.id -> o_
    val of_iri : ?actor:Types.actor -> ?g:Rdf.Graph.graph -> Iri.t -> o_
    val of_object : ?actor:Types.actor -> Types.object_ -> o_
    val can_read_object : ?actor:Types.actor -> o_ -> bool
    val delete_object : actor:Types.actor -> AP.Types.object_ -> unit Lwt.t

    val local_collection :
      ?create:[< `Inline of bool | `Ordered of bool | `Owner of Iri.t ] list ->
        Iri.t -> (local_collection, [`Msg of string]) Result.t Lwt.t

    type object_collection_fun = Types.object_ -> (local_collection, [`Msg of string]) Result.t Lwt.t
    val object_likes : object_collection_fun
    val object_announces : object_collection_fun
    val object_replies : object_collection_fun
    val object_likes_opt : Types.object_ -> local_collection option Lwt.t
    val object_announces_opt : Types.object_ -> local_collection option Lwt.t
    val object_replies_opt : Types.object_ -> local_collection option Lwt.t

    val add_reply_to : acti:Types.activity -> reply:Types.object_ -> Iri.t -> unit Lwt.t

    val dereference_activity : actor:Types.actor -> Types.activity -> Types.activity Lwt.t
    val keep_from_without_actors : Rdf.Graph.graph -> Rdf.Term.term -> Rdf.Graph.graph
  end


module Make (H: Http.T) : T = struct
    let conf = H.conf
    module H = H

    let likes_extension = ",likes"
    let announces_extension = ",shares"
    let replies_extension = ",replies"

    let dir_sep = String.get Filename.dir_sep 0
    let iri_of_dir =
      fun dir ->
        let dir = Conf.filename_from_root conf dir in
        let path = String.split_on_char dir_sep dir in
        let path = List.filter ((<>) "") path in
        Iri.append_path conf.root_iri path

    let objects_dir = Filename.concat conf.storage_root "objects"
    let foreign_objects_dir_of_actor_name = Filename.concat objects_dir
    let actor_foreign_objects_dir ?actor () =
      let name =
        match actor with
        | None -> "_"
        | Some a ->
            match a#preferred_username with
            | None ->
                Log.warn (fun m -> m "Actor %a has no preferred_username" Iri.pp a#iri);
                "_"
            | Some s -> s
      in
      foreign_objects_dir_of_actor_name name

    let public_collection_dir = Filename.concat conf.storage_root "public"

    let root_iri_s = Iri.to_string conf.root_iri

    let is_local_iri iri = AP.Utils.is_prefix_iri H.conf.root_iri iri

    let foreign_iri_file ?actor iri =
      let hexa = Cryptokit.Hexa.encode () in
      hexa#put_string  (AP.Utils.sha256 (Iri.to_string iri)) ;
      let basename = hexa#get_string in
      let path = Filename.concat (actor_foreign_objects_dir ?actor ()) basename in
      path

    let path_of_foreign_iri ?actor iri =
      let iri_s = Iri.to_string iri in
      if Conf.is_prefix iri_s root_iri_s then
        None
      else
        Some (foreign_iri_file ?actor iri)

    let path_of_local_iri iri =
      let iri = Iri.with_fragment iri None in
      let iri = Iri.with_query iri None in
      let iri_s = Iri.to_string iri in
      if not (Conf.is_prefix iri_s root_iri_s) then
        None
      else
        (
         let len_iri = String.length iri_s in
         let len_root = String.length root_iri_s in
         let path = String.sub iri_s len_root (len_iri - len_root) in
         let path = Filename.concat conf.storage_root path in
         Some path
        )

    let parse_graph = O.parse_graph (Some H.conf.jsonld_cache_dir)
    type dereferencer = ?actor:Types.actor -> Iri.t ->
      (Rdf.Graph.graph * Iri.t option, AP.E.error) result Lwt.t

    let http_query_headers ?actor ~met ?(body="") iri =
      let%lwt () = match actor with None -> Lwt.return_unit | Some a -> a#dereference in
      match actor with
      | None -> Lwt.return_none
      | Some actor ->
          match%lwt actor#private_keypem with
          | None -> Lwt.return_none
          | Some priv ->
              match actor#public_key_iri with
              | None ->
                  Log.warn (fun m -> m "Actor %a has no public key iri" Iri.pp actor#iri);
                  Lwt.return_none
              | Some pub_key_iri ->
                  let sign_fun = AP.Http_sign.rsa256_signing_with_actor
                    ~signed_headers:[ "(request-target)" ; "host" ; "date" ; "digest"]
                      pub_key_iri priv
                  in
                  let h = AP.Http_sign.add_signature_header met iri (Cohttp.Header.init()) sign_fun body in
                  Lwt.return_some h

    let httpget_headers ?actor iri = http_query_headers ?actor ~met:`GET ~body:"" iri

    let document_loader ?headers ?actor iri =
      let%lwt get_headers = httpget_headers ?actor iri in
      let headers =
        match headers, get_headers with
        | None, None -> None
        | Some h, None
        | None, Some h -> Some h
        | Some h1, Some h2 ->
            Some Cohttp.Header.(fold
             (fun h v acc -> add acc h v)
               h2 h1)
      in
      match%lwt H.get_non_rdf ?headers iri with
      | Ok (_,str) -> Lwt.return_ok str
      | Error qe ->
          let msg = Ldp.Http.string_of_query_error qe in
          let e = AP.E.Error (AP.Object.Http_error (iri, `GET, msg)) in
          Lwt.return_error e

    let jsonld_document_loader ?actor =
      AP.Utils.jsonld_document_loader (document_loader ?actor)

    let graph_to_jsonld_string ?actor g =
      let options = Rdf_json_ld.T.options (jsonld_document_loader ?actor) in
      let ds = Rdf.Ds.mem_dataset g in
      let json = Rdf_json_ld.Json_ld.from_rdf options ds in
      let json = AP.Utils.hack_jsonld json in
      Rdf_json_ld.J.to_string json

    let graph_root_to_jsonld_string ?actor g iri =
      let options = Rdf_json_ld.T.options (jsonld_document_loader ?actor) in
      let json = Rdf_json_ld.Json_ld.from_rdf_root options g iri in
      let json = AP.Utils.hack_jsonld json in
      Rdf_json_ld.J.to_string json

    let load_graph_file iri path =
      let g = Rdf.Graph.open_graph iri in
      let%lwt str = Lwt_io.(with_file ~mode:Input path read) in
      Rdf.Ttl.from_string g str;
      Lwt.return g

    let http_dereference ?actor iri =
      Log.debug (fun m -> m "http-dereferencing %a (as %s)" Iri.pp iri
         (match actor with None -> "None" | Some a -> Iri.to_string a#iri)
      );
      let%lwt cached =
        let file = foreign_iri_file ?actor iri in
        match%lwt Lwt_unix.stat file with
        | Unix.{ st_kind = S_REG } -> Lwt.return_some file
        | _ -> Lwt.return_none
        | exception _ -> Lwt.return_none
      in
      match cached with
      | Some file ->
          Log.debug (fun m -> m "http-dereferencing %a: using cache %s" Iri.pp iri file);
          let%lwt g = load_graph_file iri file in
          Lwt.return_ok (g, None)
      | None ->
          let%lwt headers = httpget_headers ?actor iri in
          match%lwt H.get_non_rdf ?headers ~accept:O.accept_rdf_cts iri with
          | Error qe ->
              let msg = Ldp.Http.string_of_query_error qe in
              Lwt.return_error (O.Http_error (iri, `GET, msg))
          | Ok (ct, body) ->
              Log.debug (fun m -> m "body=%s" body);
              parse_graph iri ct body

    let media_root_iri, media_root_dir =
      match conf.media_path with
      | None -> None, None
      | Some (path,dir) ->
          let root = if Filename.is_relative dir
            then Filename.concat conf.storage_root dir
            else dir
          in
          Some (Iri.append_path conf.root_iri (String.split_on_char '/' path)),
          Some root

    let media_path_of_iri =
      match media_root_iri, media_root_dir with
      | None,_ | _,None -> (fun _ -> None)
      | Some media_iri, Some media_root_dir ->
          let media_iri_s = Iri.to_string media_iri in
          fun iri ->
            let iri = Iri.with_query (Iri.with_fragment iri None) None in
            let iri_s = Iri.to_string iri in
            if not (Conf.is_prefix iri_s media_iri_s) then
              None
            else
              (
               let len_iri = String.length iri_s in
               let len_root = String.length media_iri_s in
               let path = String.sub iri_s len_root (len_iri - len_root) in
               let path = Filename.concat media_root_dir path in
               Some path
              )

    let gen_media_iri () =
      match media_root_iri with
      | None -> None
      | Some media_iri ->
          let (_,iri) = AP.Types.gen_id media_iri in
          match media_path_of_iri iri with
          | None -> None
          | Some p -> Some (iri, p)

    module C = Collection.Make (struct
         let iri_of_dir = iri_of_dir
         let conf = conf
       end)

    let init_local_collection = C.create
    let add_item_to_collection = C.add_item

    let items_by_page = 25

    let audience_iris o =
      let f acc lo = Iri.Set.add (Types.iri_of_lo lo) acc in
      let los = List.flatten [ o#to_ ; o#bto ; o#cc ; o#bcc ] in
      let los = match o#audience with
        | None -> los
        | Some lo -> lo :: los
      in
      List.fold_left f Iri.Set.empty los

    class type o_ = object
        inherit Types.object_
        method private g_ : Rdf.Graph.graph
        method private new_object : ?g:Rdf.Graph.graph -> Types.id -> Types.object_
        method private new_collection : ?g:Rdf.Graph.graph -> Types.id -> Types.collection
        method private new_ordered_collection : ?g:Rdf.Graph.graph -> Types.id -> Types.ordered_collection
        method private new_collection_page : ?g:Rdf.Graph.graph -> Types.id -> Types.collection_page
        method private new_ordered_collection_page : ?g:Rdf.Graph.graph -> Types.id -> Types.ordered_collection_page
        method private new_image : ?g:Rdf.Graph.graph -> Types.id -> Types.image
        method private local_dereference : dereferencer
        method private http_dereference : dereferencer
        method as_object : Types.object_
        method as_collection : Types.collection
        method as_ordered_collection : Types.ordered_collection
        method as_collection_page : Types.collection_page
        method as_ordered_collection_page : Types.ordered_collection_page
        method as_activity : Types.activity
      end

    let mk_o : (?actor:Types.actor -> ?g:Rdf.Graph.graph -> Types.id -> o_) ref =
       ref (fun ?actor ?g id -> assert false)

    let can_read_object =
      let appears_in_recipients a o =
        let eq =
          let test = Iri.equal a#iri in
          fun lo -> test (AP.Types.iri_of_lo lo)
        in
        let in_list l = List.exists eq l in
        in_list o#to_ || in_list o#bto || in_list o#cc || in_list o#bcc ||
          Option.value ~default:false (Option.map eq o#audience)
      in
      let pred_public o =
        Iri.Set.mem AS.c_Public (audience_iris o)
      in
      fun ?actor (o:o_) ->
        match actor with
        | Some a when AP.Utils.is_prefix_iri a#iri o#iri -> true
        | _ ->
            let author = match o#as_activity#actor with
              | None -> o#attributed_to
              | x -> x
            in
            match author, actor with
            | None, _ ->
                Log.debug (fun m -> m "Object.can_read_object %a: no author" Iri.pp o#iri);
                true
            | Some _, None -> pred_public o
            | Some lo, Some actor ->
                let actor_iri = actor#iri in
                Log.debug (fun m -> m "author:%a, actor:%a"
                   Iri.pp (Types.iri_of_lo lo) Iri.pp actor_iri);
                Iri.equal actor_iri (Types.iri_of_lo lo)
                  || pred_public o || appears_in_recipients actor o

    let keep_from_without_actors =
      let is_actor (_,_,term) =
        match term with
        | Rdf.Term.Iri iri -> AP.Types.actor_type_of_iri iri <> None
        | _ -> false
      in
      fun g root ->
        let keep iri =
          match g.Rdf.Graph.find ~sub:(Rdf.Term.Iri iri) ~pred:Rdf.Rdf_.type_ () with
          | [] -> true
          | l -> not (List.exists is_actor l)
        in
        AP.Utils.graph_keep_only_from ~keep g root

    class local_collection dir iri =
      object(self)
        method iri = iri
        method is_public = dir = public_collection_dir
        method add_item ?unique ?payload term : (unit, [`Msg of string]) result Lwt.t =
          let%lwt c = C.get dir self#iri in
          let%lwt () = C.add_item c ?unique ?payload term in
          Lwt.return_ok ()
        method remove_item term : (unit, [`Msg of string]) result Lwt.t =
          let%lwt c = C.get dir self#iri in
          let%lwt () = C.remove_item c term in
          Lwt.return_ok ()
        method graph_copy =
          let%lwt c = C.get dir self#iri in
          C.graph c
      end

    let is_collection o =
      match o#g with
      | None ->
          Log.warn (fun m -> m "is_collection %a: no graph" Rdf.Term.pp_term o#id);
          false
      | Some g -> C.is_collection g o#iri

    let create_local_collection =
      let rec from_flags (inline,ordered,public,owner) = function
      | [] -> (inline,ordered,public,owner)
      | (`Inline inline) :: q -> from_flags (inline,ordered,public,owner) q
      | (`Ordered ordered) :: q -> from_flags (inline,ordered,public,owner) q
      | (`Public public) :: q -> from_flags (inline,ordered,public,owner) q
      | (`Owner owner) :: q -> from_flags (inline,ordered,public,Some owner) q
      in
      fun flags dir ->
        let (inline,ordered,public,owner) = from_flags (false,false,false,None) flags in
        C.create ~inline ~ordered ~public ?owner dir

    let local_collection ?create iri =
      match path_of_local_iri iri with
      | None ->
          Log.debug (fun m -> m "local_collection %a: not a local IRI" Iri.pp iri);
          Lwt.return_error (`Msg "not a local IRI")
      | Some dir ->
          let%lwt err =
            match%lwt AP.Utils.dir_exists dir with
            | true -> Lwt.return_none
            | false ->
                match create with
                | None ->
                    let msg = Printf.sprintf
                      "local_collection %s: does not exist" (Iri.to_string iri)
                    in
                    Lwt.return_some (`Msg msg)
                | Some flags ->
                    Log.debug (fun m -> m "create_local_collection in %s for %a" dir Iri.pp iri);
                    let%lwt () = create_local_collection flags dir in
                    Lwt.return_none
          in
          match err with
          | Some err -> Lwt.return_error err
          | None ->
              match%lwt C.get_if_collection dir iri with
              | None ->
                  let msg = Printf.sprintf "%s: not a collection" (Iri.to_string iri) in
                  Lwt.return_error (`Msg msg)
              | Some _ -> Lwt.return_ok (new local_collection dir iri)

    let object_collection_iri o extension =
      match path_of_local_iri o#iri with
      | None ->
          let msg = Printf.sprintf "%s is not a local object" (Iri.to_string o#iri) in
          Lwt.return_error (`Msg msg)
      | Some path ->
          match%lwt C.get_if_collection path o#iri with
          | Some _ ->
              let msg = Printf.sprintf "Collection %s cannot have %s"
                (Rdf.Term.string_of_term o#id) extension
              in
              Lwt.return_error (`Msg msg)
          | None ->
              let dir = path ^ extension in
              Lwt.return_ok (iri_of_dir dir)

    let remove_local_collection iri =
      match path_of_local_iri iri with
      | None ->
          Log.err (fun m -> m "remove_local_collection: %a is not a local IRI" Iri.pp iri);
          Lwt.return_unit
      | Some path ->
          let%lwt () = C.delete path in
          Log.debug (fun m -> m "Collection %s deleted" path);
          Lwt.return_unit

    type object_collection_fun = Types.object_ ->  (local_collection, [`Msg of string]) Result.t Lwt.t
    let object_collection ~create extension (o:Types.object_) =
      match%lwt object_collection_iri o extension with
      | Error e -> Lwt.return_error e
      | Ok iri ->
          let create =
            if create then
              let owner = Option.map AP.Types.iri_of_lo o#attributed_to in
              let flags = [`Inline true;`Ordered true;`Public true] in
              let flags = match owner with None -> flags | Some o -> (`Owner o) :: flags in
              Some flags
            else
              None
          in
          local_collection ?create iri

    let object_likes = object_collection ~create:true likes_extension
    let object_announces = object_collection ~create:true announces_extension
    let object_replies = object_collection ~create:true replies_extension

    let err_to_opt f x = match%lwt f x with
      | Error _ -> Lwt.return_none
      | Ok v -> Lwt.return_some v
    let object_likes_opt = err_to_opt (object_collection ~create:false likes_extension)
    let object_announces_opt = err_to_opt (object_collection ~create:false announces_extension)
    let object_replies_opt = err_to_opt (object_collection ~create:false replies_extension)

    let add_object_collections =
      let f g o (pred, col_fun) =
        match%lwt col_fun o with
        | None -> Lwt.return_unit
        | Some c ->
            g.Rdf.Graph.add_triple ~sub:o#id ~pred ~obj:(Rdf.Term.Iri c#iri);
            Lwt.return_unit
      in
      fun g iri ->
        let o = (!mk_o (Rdf.Term.Iri iri))#as_object in
        Lwt_list.iter_s (f g o) [
          AS.likes, object_likes_opt ;
          AS.shares, object_announces_opt ;
          AS.replies, object_replies_opt ;
        ]

    let rec g_of_local_collection ?actor ~iri ~naked_iri ~path c =
      Log.debug(fun m -> m "g_of_local_collection %a, actor=%s" Iri.pp iri
         (match actor with None -> "None" | Some a -> Iri.to_string a#iri));
      let%lwt actor_owns_collection =
        match%lwt C.owner c with
        | None -> Lwt.return_false
        | Some o ->
            match actor with
            | None -> Lwt.return_false
            | Some a -> Lwt.return (Iri.equal a#iri o)
      in
      let%lwt items = C.items c in
      let nb_items = List.length items in
      (*Log.debug (fun m -> m "%d items: %s" (List.length items)
         (String.concat ", " (List.map Rdf.Term.string_of_term items)));*)
      let nb_pages = (nb_items / items_by_page) +
        (if nb_items mod items_by_page = 0 then 0 else 1)
      in
      let page =
        match Iri.query_opt iri "page" with
        | None -> None
        | Some str ->
            match int_of_string str with
            | n when n <= 0 -> Some 1
            | n when n <= nb_pages -> Some n
            | _ -> Some nb_pages
            | exception _ -> None
      in
      let sub = Rdf.Term.Iri iri in
      let filter =
        let pred =
          if actor_owns_collection
          then(fun _ -> true)
          else can_read_object ?actor
        in
        keep_item_object ?actor pred
      in
      match page with
      | None ->
          let%lwt g = C.graph c in
          g.Rdf.Graph.add_triple ~sub ~pred:AS.totalItems ~obj:(Rdf.Term.term_of_int nb_items);
          let paged = nb_items > items_by_page in
          let%lwt () =
            if paged then
              (
               let first = Iri.with_query_kv naked_iri (Iri.KV.singleton "page" "1") in
               let last = Iri.with_query_kv naked_iri
                 (Iri.KV.singleton "page" (string_of_int nb_pages)) in
               g.add_triple ~sub ~pred:AS.first ~obj:(Rdf.Term.Iri first);
               g.add_triple ~sub ~pred:AS.last ~obj:(Rdf.Term.Iri last);
               Lwt.return_unit
              )
            else
              (
               let%lwt _items = C.add_items_to_graph c filter sub g in
               Lwt.return_unit
              )
          in
          (*Log.debug (fun m -> m "collection returned: %s" (Rdf.Nq.graph_to_string g));*)
          Lwt.return g
      | Some p ->
          let g = Rdf.Graph.open_graph iri in
          let%lwt ordered = C.ordered c in
          let typ = if ordered then AS.c_OrderedCollectionPage else AS.c_CollectionPage in
          g.add_triple ~sub ~pred:Rdf.Rdf_.type_ ~obj:(Rdf.Term.Iri typ);
          let%lwt _items = C.add_items_to_graph
            ~slice:((p-1) * items_by_page, (p*items_by_page) - 1) c
              filter sub g
          in
          let page_term p =
            let iri = Iri.with_query_kv naked_iri
              (Iri.KV.singleton "page" (string_of_int p)) in
            Rdf.Term.Iri iri
          in
          if p > 1 then g.add_triple ~sub ~pred:AS.prev ~obj:(page_term (p-1));
          if p < nb_pages then g.add_triple ~sub ~pred:AS.next ~obj:(page_term (p+1));
          g.add_triple ~sub ~pred:AS.partOf ~obj:(Rdf.Term.Iri naked_iri);
          (*Log.debug (fun m -> m "page returned: %s" (Rdf.Nq.graph_to_string g));*)
          Lwt.return g

    and keep_item_object ?actor pred = function
      | (Rdf.Term.Iri iri) as id ->
          (match path_of_local_iri iri with
           | None ->
               (*Log.debug (fun m -> m "No path for iri %a" Iri.pp iri);*)
               Lwt.return_some None
           | Some _ ->
               match%lwt local_dereference iri with
               | Ok (go, _) ->
                   let o = !mk_o ?actor ~g:go id in
                   if pred o then
                     (* TODO: remove this comment if it's ok now
                        (* Since we store items graphs in ttl formats, we cannot
                        aggregate them in a single graph: some items may
                        have some objects in common (with same IRI) and in
                        this case each occurence of these objects will have all
                        information, including @type. This will result in
                        an object having various types. This is not
                        jsonld-comptabible and will result in an error when
                        jsonld is expanded. *)
                     Lwt.return_some None
                       *)
                     let g = match o#g with
                       | None -> None
                       | Some g -> Some (keep_from_without_actors g id)
                     in
                     Lwt.return_some g
                   else
                     Lwt.return_none
               | Error e ->
                   Log.err (fun m -> m "%a" AP.E.pp e);
                   Lwt.return_none
          )
      | _ -> Lwt.return_some None

    and local_dereference_dir ?actor ~iri ~naked_iri path =
      match%lwt C.get_if_collection path naked_iri with
      | Some c ->
          let%lwt g = g_of_local_collection ?actor ~iri ~naked_iri ~path c in
          Lwt.return_ok (g, None)
      | None -> (* not a collection *)
          (
           let g = Rdf.Graph.open_graph iri in
           match%lwt Conf.read_dir_graph conf g path with
           | Ok _ -> Lwt.return_ok (g, None)
           | Error (`Msg msg) ->
               Lwt.return_error (O.Http_error (iri, `GET, msg))
          )
      | exception (AP.E.Error e) ->
          let msg = AP.E.string_of_error e in
          Lwt.return_error (O.Http_error (iri, `GET, msg))

    and local_dereference : dereferencer = fun ?actor iri ->
        let naked_iri = Iri.with_fragment (Iri.with_query iri None) None in
        match path_of_local_iri iri with
        | None ->
            Lwt.return_error (O.Http_error (iri, `GET, "invalid local IRI"))
        | Some path ->
            let%lwt st =
              match%lwt Lwt_unix.stat path with
              | st -> Lwt.return_some st
              | exception _ -> Lwt.return_none
            in
            match st with
            | None ->
                let msg = Printf.sprintf "Resource does not exist" in
                failwith (Printf.sprintf "%s: %s" (Iri.to_string iri) msg)
                (*Lwt.return_error  (O.Http_error (iri, `GET, msg))*)
            | Some st ->
                match st.Unix.st_kind with
                | Unix.S_DIR ->
                    (* path is a directory, dereference it as a collection or an object *)
                    local_dereference_dir ?actor ~iri ~naked_iri path
                | Unix.S_REG ->
                    (* path is a file, so object is a simple object *)
                    (
                     try%lwt
                       let%lwt g = load_graph_file iri path in
                       (* add replies, shares and likes, when present *)
                       let%lwt () = add_object_collections g iri in
                       Lwt.return_ok (g, None)
                     with
                     | e ->
                         let msg = Printexc.to_string e in
                         Lwt.return_error (O.Http_error (iri, `GET, msg))
                    )
                | _ -> (* path is something else, no object here *)
                    Log.err (fun m -> m "local_deference: no file nor dir");
                    Lwt.return_error (O.Http_error (iri, `GET, "No object"))

    let dereference ?(http=http_dereference) ~(local:dereferencer) ?(actor:Types.actor option) iri =
      let iri = Iri.normalize iri in
      Log.debug (fun m -> m "dereferencing %a (root=%a)" Iri.pp iri Iri.pp conf.root_iri);
      if is_local_iri iri then
        local ?actor iri
      else
        http ?actor iri

    let store_graph g file =
      let str = Rdf.Ttl.to_string g in
      Log.debug (fun m -> m "Storing %a to %s" Iri.pp (g.Rdf.Graph.name()) file);
      Lwt_io.(with_file ~mode:Output file (fun oc -> write oc str))

    let store_local_graph g iri =
      match path_of_local_iri iri with
      | None -> failwith (Printf.sprintf "No local path for iri %s" (Iri.to_string iri))
      | Some path -> store_graph g path

    let store_foreign_graph ?actor g iri =
      match path_of_foreign_iri ?actor iri with
      | None -> failwith (Printf.sprintf "No foreign path for iri %s" (Iri.to_string iri))
      | Some path -> store_graph g path

    let store ?actor ?(prune=true) ~kind o =
      match o#id with
      | Rdf.Term.Iri iri ->
          (
           match o#g with
           | None -> failwith
               (Printf.sprintf "No graph to store for object %s" (Iri.to_string iri))
           | Some g ->
               let g = if prune then AP.Utils.graph_keep_only_from g (Rdf.Term.Iri iri) else g in
               match kind with
               | `Local -> store_local_graph g iri
               | `Foreign -> store_foreign_graph ?actor g iri
          )
      | id ->
          failwith (Printf.sprintf "Unstorable object %s" (Rdf.Term.string_of_term id))

    class o ?(http_deref=http_dereference) ~local_deref ?actor ?g id =
      object(self)
        inherit O.object_ ?g id
        method private new_object ?g id = (new o ~http_deref ~local_deref ?actor ?g id :> Types.object_)
        method private new_activity ?g id = (new o ~http_deref ~local_deref ?actor ?g id :> Types.activity)
        method private new_collection ?g id = (new o ~http_deref ~local_deref ?actor ?g id :> Types.collection)
        method private new_ordered_collection ?g id =
          (new o ~http_deref ~local_deref ?actor ?g id :> Types.ordered_collection)
        method private new_collection_page ?g id =
          (new o ~http_deref ~local_deref ?actor ?g id :> Types.collection_page)
        method private new_ordered_collection_page ?g id =
          (new o ~http_deref ~local_deref ?actor ?g id :> Types.ordered_collection_page)
        method private new_image ?g id = (new o ~http_deref ~local_deref ?actor ?g id :> Types.image)
        method private local_dereference = local_deref
        method private http_dereference = http_deref

        method dereference =
          match g with
          | Some g -> Lwt.return_unit
          | None ->
              match id with
              | Rdf.Term.Iri iri ->
                  (match%lwt dereference ~http:self#http_dereference
                    ~local:self#local_dereference ?actor iri with
                   | Error e ->
                       Log.err (fun m -> m "%s" (AP.E.string_of_error e));
                       Lwt.return_unit
                   | Ok (graph, root) ->
                       g <- Some graph;
                       Option.iter (fun root -> id <- Rdf.Term.Iri root) root ;
                       Lwt.return_unit
                  )
              | _ ->
                  Log.debug (fun m -> m "#dereference: no iri");
                  g <- Some self#g_ ; Lwt.return_unit
      end

    let get ?(actor:Types.actor option) ?g id =
      (new o ~local_deref:local_dereference ?actor ?g id :> o_)

    let () = mk_o := get

    let of_iri ?actor ?g iri = get ?actor ?g (Rdf.Term.Iri iri)
    let of_object ?actor o = get ?actor ?g:o#g o#id

    let add_reply_to ~acti ~reply iri =
      match is_local_iri iri with
      | false -> Lwt.return_unit
      | true ->
          let%lwt () = reply#dereference in
          match Option.map AP.Types.iri_of_lo reply#attributed_to with
          | None ->
              Log.err (fun m -> m "add_reply_to: %a has no author" Iri.pp reply#iri);
              Lwt.return_unit
          | Some author ->
              let replied = of_iri iri in
              let%lwt () = replied#dereference in
              (* add obj's iri in the replies *)
              match%lwt object_replies replied#as_object with
              | Error (`Msg msg) ->
                  Log.err (fun m -> m "add_reply_to: %s" msg);
                  Lwt.return_unit
              | Ok replies ->
                  let payload = [ AS.actor, Rdf.Term.Iri author ] in
                  match%lwt replies#add_item ~unique:true ~payload reply#id with
                  | Error (`Msg msg) ->
                      Log.err (fun m -> m "add_reply_to: %a: %s" Rdf.Term.pp_term acti#id msg);
                      Lwt.return_unit
                  | Ok () ->
                      Log.info (fun m -> m "Added %a to replies of %a" Iri.pp reply#iri Iri.pp replied#iri);
                      Lwt.return_unit

    let delete_object_collections =
      let f extension o =
        match%lwt object_collection_iri o extension with
        | Error (`Msg msg) ->
            Log.err (fun m -> m "delete_object_collections %a: %s" Iri.pp o#iri msg);
            Lwt.return_unit
        | Ok iri -> remove_local_collection iri
      in
      fun o ->
        let%lwt () = f likes_extension o in
        let%lwt () = f announces_extension o in
        let%lwt () = f replies_extension o in
        Lwt.return_unit

    let delete_object ~actor deleted =
      (* TODO: in collection, remove deleted items *)
      match deleted#type_ with
      | t when Iri.equal t AS.c_Tombstone ->
          (* already deleted, do nothing *)
          Lwt.return_unit
      | former_type ->
          let g = Rdf.Graph.open_graph deleted#iri in
          let sub = Rdf.Term.Iri deleted#iri in
          g.add_triple ~sub ~pred:AS.formerType ~obj:(Rdf.Term.Iri former_type);
          g.add_triple ~sub ~pred:Rdf.Rdf_.type_ ~obj:(Rdf.Term.Iri AS.c_Tombstone);
          g.add_triple ~sub ~pred:AS.deleted ~obj:(Rdf.Term.term_of_datetime());
          let kind =
            match path_of_local_iri deleted#iri with
            | None -> `Foreign
            | _ -> `Local
          in
          let%lwt () = store ~actor ~kind (get ~g deleted#id) in
          delete_object_collections deleted

    let dereference_activity =
      let rec iter ~actor g seen sub =
        let%lwt seen = seen in
        if Iri.Set.mem sub seen then
          Lwt.return seen
        else
          (* check if we must dereference or if information about sub
             is already in graph *)
          let sub_term = Rdf.Term.Iri sub in
          let%lwt () =
            match g.Rdf.Graph.find ~sub:sub_term () with
            | _ :: _ -> Lwt.return_unit
            | [] ->
                (* no info, let's dereference it *)
                let o = of_iri ~actor sub in
                let%lwt () = o#dereference in
                match o#g with
                | None -> Lwt.return_unit
                | Some g2 ->
                    Rdf.Graph.merge g g2;
                    Lwt.return_unit
          in
          List.fold_left (iter ~actor g)
            (Lwt.return seen) (Rdf.Graph.iri_objects_of g ~sub:sub_term ~pred:AS.object_)
      in
      fun ~actor activity ->
        let%lwt () = activity#dereference in
        match activity#g with
        | None ->
            Log.err (fun m -> m "Process.dereference_activity %a: no graph" Iri.pp activity#iri);
            Lwt.return activity
        | Some g ->
            let%lwt () =
              match activity#object_ with
              | None -> Lwt.return_unit
              | Some o ->
                  let%lwt _ = iter ~actor g
                    (Lwt.return (Iri.Set.singleton activity#iri)) o#iri
                  in
                  Lwt.return_unit
            in
            Lwt.return (get ~g activity#id)#as_activity
  end