|
|
@@ -650,13 +650,15 @@ let snd_reject
|
|
|
(fun _ -> Logr.info (fun m -> m "%s.%s Reject %a due to fallthrough to %a" "Ap" "snd_reject" Uri.pp id Uri.pp siac.inbox))
|
|
|
siac.inbox
|
|
|
|
|
|
+(** re-used for following as well (there using block, too) *)
|
|
|
module Followers = struct
|
|
|
+ (** follower tri-state *)
|
|
|
module State = struct
|
|
|
+ (** Tri-state *)
|
|
|
type t =
|
|
|
| Pending
|
|
|
| Accepted
|
|
|
| Blocked
|
|
|
- (** follower tri-state *)
|
|
|
|
|
|
let of_string = function
|
|
|
| "pending" -> Some Pending
|
|
|
@@ -676,14 +678,14 @@ module Followers = struct
|
|
|
then not r
|
|
|
else r
|
|
|
|
|
|
- type t' = t * Ptime.t * Uri.t * string option * Rfc7565.t option * Uri.t option
|
|
|
(** Rich follower state info:
|
|
|
- *
|
|
|
- * state, timestamp, actor id, name, rfc7565, inbox
|
|
|
+
|
|
|
+ state, timestamp, actor id, name, rfc7565, inbox
|
|
|
*)
|
|
|
+ type t' = t * Ptime.t * Uri.t * string option * Rfc7565.t option * Uri.t option
|
|
|
|
|
|
let ibox (_,_,ibox,_,_,_ : t') : Uri.t = ibox
|
|
|
- (* input to fold_left *)
|
|
|
+ (** input to fold_left *)
|
|
|
let ibox' f a (k,v) = f a (k,v |> ibox)
|
|
|
|
|
|
let of_actor tnow st (siac : As2_vocab.Types.person) : t' =
|
|
|
@@ -779,6 +781,7 @@ module Followers = struct
|
|
|
assert (id |> Uri.user |> Option.is_none);
|
|
|
Mapcdb.update_string (id |> Uri.to_string) (v |> State.encode |> Csexp.to_string) cdb
|
|
|
|
|
|
+ (** remove from cdb *)
|
|
|
let remove ?(cdb = cdb) id =
|
|
|
assert (id |> Uri.user |> Option.is_none);
|
|
|
Mapcdb.remove_string (id |> Uri.to_string) cdb
|
|
|
@@ -789,8 +792,9 @@ module Followers = struct
|
|
|
|> find ~cdb
|
|
|
|> State.is_accepted
|
|
|
|
|
|
+ (** https://www.rfc-editor.org/rfc/rfc4287#section-4.1.1 *)
|
|
|
module Atom = struct
|
|
|
- (* create all from oldest to newest and return newest file name. *)
|
|
|
+ (** create all from oldest to newest and return newest file name. *)
|
|
|
let of_cdb
|
|
|
?(cdb = cdb)
|
|
|
?(predicate = State.predicate ~invert:false)
|
|
|
@@ -901,6 +905,7 @@ module Followers = struct
|
|
|
let make = Make.make [rule]
|
|
|
end
|
|
|
|
|
|
+ (** https://www.w3.org/TR/activitypub/#followers *)
|
|
|
module Json = struct
|
|
|
let to_page ~is_last (i : int) (fs : Uri.t list) : Uri.t As2_vocab.Types.collection_page =
|
|
|
let p i =
|
|
|
@@ -926,18 +931,18 @@ module Followers = struct
|
|
|
total_items= None;
|
|
|
}
|
|
|
|
|
|
+ (** write one page of an https://www.w3.org/TR/activitystreams-vocabulary/#dfn-orderedcollection *)
|
|
|
let to_page_json ~base _prefix ~is_last (i : int) (ids : Uri.t list) =
|
|
|
to_page ~is_last i ids
|
|
|
|> As2_vocab.Encode.(collection_page ~base (uri ~base))
|
|
|
|
|
|
- (**
|
|
|
- * dehydrate into https://www.w3.org/TR/activitystreams-vocabulary/#dfn-orderedcollection
|
|
|
- * and https://www.w3.org/TR/activitystreams-vocabulary/#dfn-orderedcollectionpage
|
|
|
- * dst afterwards contains an
|
|
|
- * index.jsa
|
|
|
- * index-0.jsa
|
|
|
- * ...
|
|
|
- * index-n.jsa
|
|
|
+ (** dehydrate into https://www.w3.org/TR/activitystreams-vocabulary/#dfn-orderedcollection
|
|
|
+ and https://www.w3.org/TR/activitystreams-vocabulary/#dfn-orderedcollectionpage
|
|
|
+ dst afterwards contains an
|
|
|
+ index.jsa
|
|
|
+ index-0.jsa
|
|
|
+ ...
|
|
|
+ index-n.jsa
|
|
|
*)
|
|
|
let flush_page_json ~base ~oc prefix ~is_last (tot,pa,lst,_) =
|
|
|
let fn j = j |> Printf.sprintf "%d.jsa" in
|
|
|
@@ -962,19 +967,19 @@ module Followers = struct
|
|
|
|> As2_vocab.Encode.(collection ~base (uri ~base))
|
|
|
|> Ezjsonm.value_to_channel ~minify:false oc)
|
|
|
|
|
|
+ (** paging logic *)
|
|
|
let fold2pages pagesize flush_page (tot,pa,lst,i) id =
|
|
|
Logr.debug (fun m -> m "%s.%s %a" "Ap.Followers" "fold2pages" Uri.pp id );
|
|
|
if i >= pagesize
|
|
|
then (
|
|
|
flush_page ~is_last:false (tot,pa,lst,i);
|
|
|
- (tot+1,pa+1,id :: [],0)
|
|
|
+ (tot |> succ,pa |> succ,id :: [],0)
|
|
|
) else
|
|
|
- (tot+1,pa,id :: lst,i+1)
|
|
|
+ (tot |> succ,pa,id :: lst,i |> succ)
|
|
|
+
|
|
|
+ (** dehydrate the cdb (e.g. followers list) into the current directory
|
|
|
|
|
|
- (**
|
|
|
- * dehydrate the cdb (e.g. followers list) into the current directory
|
|
|
- *
|
|
|
- * uses fold2pages & flush_page
|
|
|
+ uses fold2pages & flush_page_json
|
|
|
*)
|
|
|
let coll_of_cdb
|
|
|
~base
|
|
|
@@ -983,7 +988,6 @@ module Followers = struct
|
|
|
?(predicate = State.predicate ~invert:false)
|
|
|
prefix cdb =
|
|
|
assert (0 < pagesize && pagesize < 10_001);
|
|
|
- let _ = predicate in
|
|
|
(* Logr.debug (fun m -> m "%s.%s %d %a" "Ap.Followers" "cdb2coll" pagesize Uri.pp base ); *)
|
|
|
let base = Http.reso ~base (Uri.make ~path:prefix ()) in
|
|
|
let* res = fold_left (fun a (k,(s,_,_,_,_,_)) ->
|
|
|
@@ -1098,6 +1102,7 @@ module Followers = struct
|
|
|
|> send ~key side_ok siac.inbox
|
|
|
end
|
|
|
|
|
|
+(** Logic for https://www.w3.org/TR/activitypub/#following *)
|
|
|
module Following = struct
|
|
|
let n = "subscribed_to"
|
|
|
let cdb = Mapcdb.Cdb ("app/var/db/" ^ n ^ ".cdb")
|
|
|
@@ -1106,9 +1111,11 @@ module Following = struct
|
|
|
let remove ?(cdb = cdb) = Followers.remove ~cdb
|
|
|
let update ?(cdb = cdb) = Followers.update ~cdb
|
|
|
|
|
|
+ (** lists whom I subscribed to *)
|
|
|
module Subscribed_to = struct
|
|
|
let dir = apub ^ n ^ "/"
|
|
|
|
|
|
+ (** Mostly delegates to Followers.Atom.of_cdb *)
|
|
|
module Atom = struct
|
|
|
let target = dir ^ "index.xml"
|
|
|
|
|
|
@@ -1130,6 +1137,7 @@ module Following = struct
|
|
|
}
|
|
|
end
|
|
|
|
|
|
+ (** Mostly delegates to Followers.Json.coll_of_cdb *)
|
|
|
module Json = struct
|
|
|
let target = dir ^ "index.jsa"
|
|
|
|
|
|
@@ -1153,9 +1161,11 @@ module Following = struct
|
|
|
|> find ~cdb
|
|
|
|> Followers.State.is_accepted
|
|
|
|
|
|
+ (** lists whom I block *)
|
|
|
module Blocked = struct
|
|
|
let dir = apub ^ "blocked" ^ "/"
|
|
|
|
|
|
+ (** Mostly delegates to Followers.Atom.of_cdb *)
|
|
|
module Atom = struct
|
|
|
let target = dir ^ "index.xml"
|
|
|
|
|
|
@@ -1178,6 +1188,7 @@ module Following = struct
|
|
|
}
|
|
|
end
|
|
|
|
|
|
+ (** Mostly delegates to Followers.Json.coll_of_cdb *)
|
|
|
module Json = struct
|
|
|
let target = dir ^ "index.jsa"
|
|
|
|
|
|
@@ -1420,6 +1431,7 @@ module Note = struct
|
|
|
summary_map = if sensitive then summary_map else [];
|
|
|
url = [n.id] }
|
|
|
|
|
|
+ (** https://www.w3.org/TR/activitypub/#create-activity-outbox *)
|
|
|
module Create = struct
|
|
|
let make (obj : As2_vocab.Types.note) : As2_vocab.Types.note As2_vocab.Types.create =
|
|
|
let frag = match obj.id |> Uri.fragment with
|
|
|
@@ -1445,6 +1457,7 @@ module Note = struct
|
|
|
|> As2_vocab.Encode.(create ~base ~context (note ~base))
|
|
|
end
|
|
|
|
|
|
+ (** Rather use a tombstone? https://www.w3.org/TR/activitypub/#delete-activity-outbox *)
|
|
|
module Delete = struct
|
|
|
let make (obj : As2_vocab.Types.note) : As2_vocab.Types.note As2_vocab.Types.delete =
|
|
|
let frag = match obj.id |> Uri.fragment with
|
Marcus Rohrmoser