aboutsummaryrefslogtreecommitdiff
path: root/lib/activitypub
diff options
context:
space:
mode:
authorMarc Coquand <marc@mccd.space>2023-12-20 20:46:00 -0600
committerMarc Coquand <marc@mccd.space>2023-12-25 18:22:59 -0600
commit262f161f42c4e59beec41c6f440336c38385426a (patch)
tree6491c9b661a0b5a14c9a30ecf25e036f8762239d /lib/activitypub
parentcc783c157f31e7e713c8b83be67449b1859dac27 (diff)
downloadfixgen-262f161f42c4e59beec41c6f440336c38385426a.tar.gz
fixgen-262f161f42c4e59beec41c6f440336c38385426a.tar.bz2
fixgen-262f161f42c4e59beec41c6f440336c38385426a.zip
Initial commit
Diffstat (limited to 'lib/activitypub')
-rw-r--r--lib/activitypub/activitypub.ml5
-rw-r--r--lib/activitypub/common.ml47
-rw-r--r--lib/activitypub/constants.ml49
-rw-r--r--lib/activitypub/decode.ml352
-rw-r--r--lib/activitypub/dune3
-rw-r--r--lib/activitypub/encode.ml303
-rw-r--r--lib/activitypub/readme.md5
-rw-r--r--lib/activitypub/types.ml245
8 files changed, 0 insertions, 1009 deletions
diff --git a/lib/activitypub/activitypub.ml b/lib/activitypub/activitypub.ml
deleted file mode 100644
index 511b4a3..0000000
--- a/lib/activitypub/activitypub.ml
+++ /dev/null
@@ -1,5 +0,0 @@
-module Common = Common
-module Constants = Constants
-module Types = Types
-module Encode = Encode
-module Decode = Decode
diff --git a/lib/activitypub/common.ml b/lib/activitypub/common.ml
deleted file mode 100644
index 59c7099..0000000
--- a/lib/activitypub/common.ml
+++ /dev/null
@@ -1,47 +0,0 @@
-module D = Decoders_yojson.Safe.Decode
-
-let timestamp =
- let open D in
- let* time = string in
- match Ptime.of_rfc3339 time |> Ptime.rfc3339_error_to_msg with
- | Ok (t, _, _) -> succeed t
- | Error `Msg err -> fail err
-
-let singleton_or_list dec =
- D.(one_of ["singleton", (dec >|= fun v -> [v]);
- "list", list dec;
- "null", null >|= fun () -> []])
-
-let lossy_list_of dec =
- let open D in
- list (one_of ["known", (dec >|= fun v -> `Value v); "unknown", value >|= fun v -> `Raw v])
-
-
-let constant ?msg target =
- let open D in
- let* str = string in
- if String.equal str target
- then succeed ()
- else match msg with
- | None -> fail (Printf.sprintf "expected %s received %s" target str)
- | Some msg -> fail (Printf.sprintf msg str)
-
-let field_or_default field' decoder default =
- let open D in
- let+ field = field_opt field' decoder in
- Option.value ~default field
-
-let list_ignoring_unknown ty =
- let open D in
- list (maybe ty) >|= fun v -> List.filter_map Fun.id v
-
-let items obj =
- let open D in
- one_of [
- ("ordered items",
- let* items = field "orderedItems" (list obj) in
- succeed (true, items));
- "items",
- let* items = field "items" (list obj) in
- succeed (false, items)
- ]
diff --git a/lib/activitypub/constants.ml b/lib/activitypub/constants.ml
deleted file mode 100644
index 0488335..0000000
--- a/lib/activitypub/constants.ml
+++ /dev/null
@@ -1,49 +0,0 @@
-open Containers
-
-module ContentType = struct
- let ld_json_activity_streams = "application/ld+json; profile=\"https://www.w3.org/ns/activitystreams\""
-
- let xrd_xml = "application/xrd+xml"
- let ld_json = "application/ld+json"
- let activity_json = "application/activity+json"
- let plain_json = "application/json"
- let html = "text/html"
- let any = "*/*"
-
- let content_types = [
- ld_json_activity_streams, `JSON;
- ld_json, `JSON;
- activity_json, `JSON;
- plain_json, `JSON;
- html, `HTML;
- any, `HTML;
- ]
-
- let of_string content_type =
- List.find_opt
- (fun (str, _) ->
- String.prefix ~pre:str content_type) content_types
- |> Option.map snd
-
-
-end
-
-module Webfinger = struct
- let json_rd = "application/jrd+json"
-
- let self_rel = "self"
- let ostatus_rel = "http://ostatus.org/schema/1.0/subscribe"
- let profile_page = "http://webfinger.net/rel/profile-page"
-end
-
-module ActivityStreams = struct
-
- let public = "https://www.w3.org/ns/activitystreams#Public"
-
- let context : string * Yojson.Safe.t =
- "@context", `List [
- `String "https://www.w3.org/ns/activitystreams";
- `String "https://w3id.org/security/v1"
- ]
-
-end
diff --git a/lib/activitypub/decode.ml b/lib/activitypub/decode.ml
deleted file mode 100644
index 4074e68..0000000
--- a/lib/activitypub/decode.ml
+++ /dev/null
@@ -1,352 +0,0 @@
-open Containers
-open Common
-
-let decode_string enc vl = D.decode_string enc vl |> Result.map_err D.string_of_error
-
-let id = D.(one_of ["string", string; "id", field "id" string])
-
-let ordered_collection_page obj =
- let open D in
- let* () = field "type" @@ constant ~msg:"Expected OrderedCollectionPage (received %s)" "OrderedCollectionPage"
- and* id = field "id" string
- and* next = field_opt "next" id
- and* prev = field_opt "prev" id
- and* part_of = field_opt "partOf" string
- and* total_items = field_opt "totalItems" int
- and* (is_ordered, items) = items obj in
- succeed ({id; next; prev; part_of; total_items; is_ordered; items}: _ Types.ordered_collection_page)
-
-let ordered_collection obj =
- let open D in
- let* () = field "type" @@ constant ~msg:"Expected OrderedCollection (received %s)" "OrderedCollection"
- and* id = field_opt "id" string
- and* total_items = field "totalItems" int
- and* contents =
- one_of [
- "items", map (fun v -> `Items v) (items obj);
- "first", map (fun v -> `First v) (field "first" (ordered_collection_page obj))
- ] in
- succeed ({id; total_items; contents}: _ Types.ordered_collection)
-
-let mention =
- let open D in
- let* () = field "type" @@ constant ~msg:"expected Mention (received %s)" "Mention"
- and* href = field "href" string
- and* name = field "name" string in
- succeed ({ty=`Mention; href;name} : Types.tag)
-
-let hashtag =
- let open D in
- let* () = field "type" @@ constant ~msg:"expected Hashtag (received %s)" "Hashtag"
- and* href = field "href" string
- and* name = field "name" string in
- succeed ({ty=`Hashtag; href;name}: Types.tag)
-
-let tag =
- let open D in
- let* ty = field "type" string in
- match ty with
- | "Mention" -> mention
- | "Hashtag" -> hashtag
- | _ -> fail (Printf.sprintf "unknown tag %s" ty)
-
-let undo obj =
- let open D in
- let* () = field "type" @@ constant ~msg:"expected Undo (received %s)" "Undo"
- and* id = field "id" string
- and* actor = field "actor" id
- and* published = field_opt "published" timestamp
- and* obj = field "object" obj
- and* raw = value in
- succeed ({id;published;actor;obj;raw}: _ Types.undo)
-
-let like =
- let open D in
- let* () = field "type" @@ constant ~msg:"expected Like (received %s)" "Like"
- and* id = field "id" string
- and* actor = field "actor" id
- and* published = field_opt "published" timestamp
- and* obj = field "object" id
- and* raw = value in
- succeed ({id; actor; published; obj; raw}: Types.like)
-
-let tombstone =
- let open D in
- let* () = field "type" @@ constant ~msg:"expected Tombstone (received %s)" "Tombstone"
- and* id = field "id" string in
- succeed id
-
-let delete obj =
- let open D in
- let* () = field "type" @@ constant ~msg:"expected Delete (received %s)" "Delete"
- and* id = field "id" string
- and* actor = field "actor" id
- and* published = field_opt "published" timestamp
- and* obj = field "object" obj
- and* raw = value in
- succeed ({id;published;actor;obj;raw}: _ Types.delete)
-
-let block =
- let open D in
- let* () = field "type" @@ constant ~msg:"expected Block (received %s)" "Block"
- and* id = field "id" string
- and* obj = field "object" string
- and* published = field_opt "published" timestamp
- and* actor = field "actor" id
- and* raw = value in
- succeed ({id;published;obj;actor;raw}: Types.block)
-
-let accept obj =
- let open D in
- let* () = field "type" @@ constant ~msg:"expected Accept (received %s)" "Accept"
- and* id = field "id" string
- and* actor = field "actor" id
- and* published = field_opt "published" timestamp
- and* obj = field "object" obj
- and* raw = value in
- succeed ({id;published;actor;obj;raw}: _ Types.accept)
-
-let public_key =
- let open D in
- let* id = field "id" string
- and* owner = field "owner" string
- and* pem = field "publicKeyPem" string in
- succeed ({id;owner;pem}: Types.public_key)
-
-let attachment =
- let open D in
- let* media_type = field_opt "mediaType" string
- and* name = field_opt "name" string
- and* type_ = field_opt "type" string
- and* url = field "url" string in
- succeed ({media_type;name;type_;url}: Types.attachment)
-
-
-let person =
- let open D in
- let* () = field "type" @@ constant ~msg:"expected Person (received %s)" "Person"
- and* id = field "id" string
- and* name = field_opt "name" string
- and* url = field_or_default "url" (nullable string) None
- and* preferred_username = field_opt "preferredUsername" string
- and* inbox = field "inbox" string
- and* outbox = field "outbox" string
- and* summary = field_opt "summary" string
- and* public_key = field "publicKey" public_key
- and* manually_approves_followers =
- field_or_default "manuallyApprovesFollowers" bool false
- and* discoverable = field_or_default "discoverable" bool false
- and* followers = field_opt "followers" string
- and* following = field_opt "following" string
- and* icon = maybe (at ["icon";"url"] string)
- and* raw = value in
- succeed ({
- id;
- name;
- url;
-
- preferred_username;
-
- inbox;
- outbox;
-
- summary;
-
- public_key;
-
- manually_approves_followers;
-
- discoverable;
- followers;
- following;
- icon;
- raw;
- }: Types.person)
-
-let note =
- let open D in
- let* () = field "type" @@ constant ~msg:"expected Note (received %s)" "Note"
- and* id = field "id" string
- and* actor = one_of ["actor", field "actor" id; "attributed_to", field "attributedTo" id]
- and* attachment = field_or_default "attachment" (singleton_or_list attachment) []
- and* to_ = field "to" (singleton_or_list string)
- and* in_reply_to = field_or_default "inReplyTo" (nullable string) None
- and* cc = field_or_default "cc" (singleton_or_list string) []
- and* content = field "content" string
- and* source = field_opt "source"
- (one_of ["string", string; "multi-encode", field "content" string])
- and* summary = field_or_default "summary" (nullable string) None
- and* sensitive = field_or_default "sensitive" (nullable bool) None
- and* published = field_opt "published" timestamp
- and* tags = field_or_default "tag" (lossy_list_of tag) []
- and* raw = value in
- succeed ({ id; actor; attachment; in_reply_to; to_; cc;
- sensitive=Option.value ~default:false sensitive;
- content; source; summary; tags; published; raw }: Types.note)
-
-let follow =
- let open D in
- let* () = field "type" @@ constant ~msg:"expected create object (received %s)" "Follow"
- and* actor = field "actor" id
- and* cc = field_or_default "cc" (singleton_or_list string) []
- and* to_ = field_or_default "to" (singleton_or_list string) []
- and* id = field "id" string
- and* object_ = field "object" id
- and* state = field_opt "state" (string >>= function "pending" -> succeed `Pending
- | "cancelled" -> succeed `Cancelled
- | _ -> fail "unknown status")
- and* raw = value in
- succeed ({actor; cc; to_; id; object_; state; raw}: Types.follow)
-
-let announce obj =
- let open D in
- let* () = field "type" @@ constant ~msg:"expected create object (received %s)" "Announce"
- and* actor = field "actor" id
- and* id = field "id" string
- and* published = field_opt "published" timestamp
- and* to_ = field "to" (singleton_or_list string)
- and* cc = field_or_default "cc" (singleton_or_list string) []
- and* obj = field "object" obj
- and* raw = value in
- succeed ({id; published; actor; to_; cc; obj; raw}: _ Types.announce)
-
-let create obj =
- let open D in
- let* () = field "type" @@ constant ~msg:"expected create object (received %s)" "Create"
- and* id = field "id" string
- and* actor = field "actor" id
- and* direct_message = field_or_default "direct" bool false
- and* published = field_opt "published" timestamp
- and* to_ = field_or_default "to" (singleton_or_list string) []
- and* cc = field_or_default "cc" (singleton_or_list string) []
- and* obj = field "object" obj
- and* raw = value in
-
- succeed ({
- id; actor; published;
- to_; cc;
- direct_message;
- obj;
- raw;
- }: _ Types.create)
-
-let core_obj () =
- let open D in
- let* ty = field_opt "type" string in
- match ty with
- | Some "Person" -> person >|= fun v -> `Person v
- | Some "Follow" -> follow >|= fun v -> `Follow v
- | Some "Note" -> note >|= fun v -> `Note v
- | Some "Block" -> block >|= fun v -> `Block v
- | Some "Like" -> like >|= fun v -> `Like v
- | None -> string >|= fun v -> `Link v
- | Some ev -> fail ("unsupported event" ^ ev)
-
-let core_obj = core_obj ()
-
-let event (enc: Types.core_obj D.decoder) : Types.obj D.decoder =
- let open D in
- let* ty = field "type" string in
- match ty with
- | "Create" -> create enc >|= fun v -> `Create v
- | "Accept" -> accept enc >|= fun v -> `Accept v
- | "Undo" -> undo enc >|= fun v -> `Undo v
- | "Delete" -> delete enc >|= fun v -> `Delete v
- | "Announce" -> announce enc >|= fun v -> `Announce v
- | _ -> fail "unsupported event"
-
-let obj : Types.obj D.decoder =
- D.one_of [
- "core_obj", core_obj;
- "core_obj event", (event core_obj)
- ]
-
-module Webfinger = struct
-
- let ty =
- let open D in
- string >>= function
- | str when String.prefix ~pre:Constants.ContentType.html str ->
- succeed `Html
- | str when String.prefix ~pre:Constants.ContentType.plain_json str ->
- succeed `Json
- | str when String.prefix ~pre:Constants.ContentType.activity_json str ->
- succeed `ActivityJson
- | str when String.prefix ~pre:Constants.ContentType.ld_json_activity_streams str ->
- succeed `ActivityJsonLd
- | _ ->
- fail "unsupported self link type"
-
- let self =
- let open D in
- let* ty = field "type" ty
- and* href = field "href" string in
- succeed @@ Types.Webfinger.Self (ty, href)
-
- let profile_page =
- let open D in
- let* ty = field "type" ty
- and* href = field "href" string in
- succeed @@ Types.Webfinger.ProfilePage (ty, href)
-
- let ostatus_subscribe =
- let open D in
- let* template = field "template" string in
- succeed @@ Types.Webfinger.OStatusSubscribe template
-
- let link =
- let open D in
- let* rel = field "rel" string in
- match rel with
- | "self" -> self
- | str when String.equal str Constants.Webfinger.ostatus_rel ->
- ostatus_subscribe
- | str when String.equal str Constants.Webfinger.profile_page ->
- profile_page
- | _ -> fail "unsupported link relation"
-
- let query_result =
- let open D in
- let* subject = field "subject" string
- and* aliases = field "aliases" (list string)
- and* links = field "links" (list_ignoring_unknown link) in
-
- succeed Types.Webfinger.{subject;aliases;links}
-
-end
-
-module Nodeinfo = struct
-
- let software =
- let open D in
- let* name = field "name" string
- and* version = field "version" string in
- succeed @@ Types.Nodeinfo.{name;version}
-
- let usage_users =
- let open D in
- let* total = field_or_default "total" int 0
- and* active_month = field_or_default "activeMonth" int 0
- and* active_half_year = field_or_default "activeHalfyear" int 0 in
- succeed @@ Types.Nodeinfo.{total; active_month; active_half_year}
-
- let usage =
- let open D in
- let* users = field "users" usage_users
- and* local_posts = field_or_default "localPosts" int 0 in
- succeed @@ Types.Nodeinfo.{users; local_posts}
-
- let t =
- let open D in
- let* software = field "software" software
- and* protocols = field_or_default "protocols" (list string) []
- and* inbound_services = field_or_default "services" (field_or_default "inbound" (list string) []) []
- and* outbound_services = field_or_default "services" (field_or_default "outbound" (list string) []) []
- and* usage = field "usage" usage
- and* open_registrations = field_or_default "openRegistrations" bool false
- and* metadata = field_opt "metadata" value
- and* raw = value in
- succeed @@ Types.Nodeinfo.{software;protocols;inbound_services;outbound_services;usage;open_registrations;metadata;raw}
-
-
-end
diff --git a/lib/activitypub/dune b/lib/activitypub/dune
deleted file mode 100644
index 9222a82..0000000
--- a/lib/activitypub/dune
+++ /dev/null
@@ -1,3 +0,0 @@
-(library (name activitypub)
- (preprocess (pps ppx_deriving.std))
- (libraries containers uri yojson decoders decoders-yojson ptime))
diff --git a/lib/activitypub/encode.ml b/lib/activitypub/encode.ml
deleted file mode 100644
index 2b64e76..0000000
--- a/lib/activitypub/encode.ml
+++ /dev/null
@@ -1,303 +0,0 @@
-module E = Decoders_yojson.Safe.Encode
-
-
-let (<:) = function
- | (_, None) -> fun _ -> []
- | (field, Some vl) -> fun ty -> [field, ty vl]
-let (@) field vl = (field, Some vl)
-let (@?) field vl = (field, vl)
-
-let ptime time = E.string (Ptime.to_rfc3339 ~tz_offset_s:0 time)
-let obj ls = E.obj @@ List.flatten ls
-let ap_obj ty ls =
- E.obj (Constants.ActivityStreams.context :: ("type", E.string ty) :: List.flatten ls)
-
-let or_raw conv = function
- | `Raw v -> v
- | `Value v -> conv v
-
-(** * Collections *)
-let ordered_collection_page enc
- ({ id; prev; next; is_ordered; items; part_of; total_items }:
- _ Types.ordered_collection_page) =
- ap_obj "OrderedCollectionPage" [
- "id" @ id <: E.string;
- "next" @? next <: E.string;
- "prev" @? prev <: E.string;
- "partOf" @? part_of <: E.string;
- "totalItems" @? total_items <: E.int;
- (match is_ordered with
- | true -> "orderedItems"
- | false -> "items") @ items <: E.list enc
- ]
-
-let ordered_collection enc
- ({ id; total_items; contents }: _ Types.ordered_collection) =
- ap_obj "OrderedCollection" [
- "id" @? id <: E.string;
- "totalItems" @ total_items <: E.int;
- match contents with
- | `First page -> "first" @ page <: ordered_collection_page enc
- | `Items (true, items) -> "orderedItems" @ items <: E.list enc
- | `Items (false, items) -> "items" @ items <: E.list enc
- ]
-
-(** * Events *)
-
-let create enc ({ id; actor; published; to_; cc; direct_message; obj; raw=_ }:
- _ Types.create) =
- ap_obj "Create" [
- "id" @ id <: E.string;
- "actor" @ actor <: E.string;
- "published" @? published <: ptime;
- "to" @ to_ <: E.(list string);
- "cc" @ cc <: E.(list string);
- "directMessage" @ direct_message <: E.bool;
- "object" @ obj <: enc;
- ]
-
-let announce enc ({ id; actor; published; to_; cc; obj; raw=_ } : _ Types.announce) =
- ap_obj "Announce" [
- "id" @ id <: E.string;
- "actor" @ actor <: E.string;
- "published" @? published <: ptime;
- "to" @ to_ <: E.(list string);
- "cc" @ cc <: E.(list string);
- "object" @ obj <: enc;
- ]
-
-let accept enc ({ id; actor; published; obj; raw=_ } : _ Types.accept) =
- ap_obj "Accept" [
- "id" @ id <: E.string;
- "actor" @ actor <: E.string;
- "published" @? published <: ptime;
- "object" @ obj <: enc;
- ]
-
-let undo enc ({ id; actor; published; obj; raw=_ } : _ Types.undo) =
- ap_obj "Undo" [
- "id" @ id <: E.string;
- "actor" @ actor <: E.string;
- "published" @? published <: ptime;
- "object" @ obj <: enc;
- ]
-
-let delete enc ({ id; actor; published; obj; raw=_ } : _ Types.delete) =
- ap_obj "Delete" [
- "id" @ id <: E.string;
- "actor" @ actor <: E.string;
- "published" @? published <: ptime;
- "object" @ obj <: enc;
- ]
-
-(** * Objects *)
-
-let public_key (key: Types.public_key) =
- obj [
- "id" @ key.id <: E.string;
- "owner" @ key.owner <: E.string;
- "publicKeyPem" @ key.pem <: E.string;
- ]
-
-let icon (url: string) =
- obj [
- "type" @ "Image" <: E.string;
- "url" @ url <: E.string;
- ]
-
-let person ({ id; name; url; inbox; outbox;
- preferred_username; summary;
- manually_approves_followers;
- discoverable; followers; following;
- public_key=key; icon=i; raw=_ }: Types.person) =
- ap_obj "Person" [
-
- "id" @ id <: E.string;
-
- "name" @? name <: E.string;
- "url" @? url <: E.string;
-
- "preferredUsername" @? preferred_username <: E.string;
-
- "inbox" @ inbox <: E.string;
- "outbox" @ outbox <: E.string;
-
- "summary" @? summary <: E.string;
-
- "publicKey" @ key <: public_key;
-
- "manuallyApprovesFollowers" @ manually_approves_followers <: E.bool;
-
- "discoverable" @ discoverable <: E.bool;
-
- "followers" @? followers <: E.string;
- "following" @? following <: E.string;
-
- "icon" @? i <: icon;
- ]
-
-let state = function
- `Pending -> E.string "pending"
- | `Cancelled -> E.string "cancelled"
-
-
-let follow ({ id; actor; cc; object_; to_; state=st; raw=_ }: Types.follow) =
- ap_obj "Follow" [
- "id" @ id <: E.string;
- "actor" @ actor <: E.string;
- "to" @ to_ <: E.list E.string;
- "cc" @ cc <: E.list E.string;
- "object" @ object_ <: E.string;
- "state" @? st <: state;
- ]
-
-let tag ({ ty; href; name }: Types.tag) =
- ap_obj (match ty with `Mention -> "Mention" | `Hashtag -> "Hashtag") [
- "href" @ href <: E.string;
- "name" @ name <: E.string;
- ]
-
-let attachment ({media_type; name; url; type_}: Types.attachment) =
- obj [
- "type" @? type_ <: E.string;
- "mediaType" @? media_type <: E.string;
- "name" @? name <: E.string;
- "url" @ url <: E.string;
- ]
-
-let note ({ id; actor; to_; in_reply_to; cc; content; sensitive; source; summary;
- attachment=att;
- published; tags; raw=_ }: Types.note) =
- let att = match att with [] -> None | _ -> Some att in
- ap_obj "Note" [
- "id" @ id <: E.string;
- "actor" @ actor <: E.string;
- "attachment" @? att <: E.list attachment;
- "to" @ to_ <: E.list E.string;
- "inReplyTo" @? in_reply_to <: E.string;
- "cc" @ cc <: E.list E.string;
- "content" @ content <: E.string;
- "sensitive" @ sensitive <: E.bool;
- "source" @? source <: E.string;
- "summary" @? summary <: E.string;
- "published" @? published <: ptime;
- "tags" @ tags <: E.list (or_raw tag);
- ]
-
-let block ({ id; obj; published; actor; raw=_ }: Types.block) =
- ap_obj "Block" [
- "id" @ id <: E.string;
- "object" @ obj <: E.string;
- "actor" @ actor <: E.string;
- "published" @? published <: ptime;
- ]
-
-let like ({ id; actor; published; obj; raw=_ }: Types.like) =
- ap_obj "Like" [
- "id" @ id <: E.string;
- "actor" @ actor <: E.string;
- "object" @ obj <: E.string;
- "published" @? published <: ptime;
- ]
-
-
-let core_obj : Types.core_obj E.encoder = function
- | `Follow f -> follow f
- | `Block b -> block b
- | `Note n -> note n
- | `Person p -> person p
- | `Like l -> like l
- | `Link r -> E.string r
-
-let event enc : _ Types.event E.encoder = function
- | `Announce a -> announce enc a
- | `Undo u -> undo enc u
- | `Delete d -> delete enc d
- | `Create c -> create enc c
- | `Accept a -> accept enc a
-
-let object_ : Types.obj E.encoder = function
- | #Types.core_obj as c -> core_obj c
- | #Types.core_event as e -> event core_obj e
-
-module Webfinger = struct
-
- let ty = function
- | `ActivityJson -> E.string Constants.ContentType.activity_json
- | `Html -> E.string Constants.ContentType.html
- | `ActivityJsonLd -> E.string Constants.ContentType.ld_json_activity_streams
- | `Json -> E.string Constants.ContentType.plain_json
-
- let link = function
- | Types.Webfinger.Self (t, href) -> obj [
- "href" @ href <: E.string;
- "rel" @ Constants.Webfinger.self_rel <: E.string;
- "type" @ t <: ty;
- ]
- | ProfilePage (t, href) ->
- obj [
- "href" @ href <: E.string;
- "rel" @ Constants.Webfinger.profile_page <: E.string;
- "type" @ t <: ty;
- ]
- | OStatusSubscribe template -> obj [
- "rel" @ Constants.Webfinger.ostatus_rel <: E.string;
- "template" @ template <: E.string;
- ]
-
- let query_result ({subject;aliases;links}: Types.Webfinger.query_result) =
- obj [
- "subject" @ subject <: E.string;
- "aliases" @ aliases <: E.(list string);
- "links" @ links <: E.list link;
- ]
-
-end
-
-module Nodeinfo = struct
-
- let software (s: Types.Nodeinfo.software) =
- obj [
- "name" @ s.name <: E.string;
- "version" @ s.version <: E.string;
- ]
-
- let usage_users ({ total; active_month; active_half_year }: Types.Nodeinfo.usage_users) =
- obj [
- "total" @ total <: E.int;
- "activeMonth" @ active_month <: E.int;
- "activeHalfyear" @ active_half_year <: E.int;
- ]
-
- let usage ({ local_posts; users } : Types.Nodeinfo.usage) =
- obj [
- "users" @ users <: usage_users;
- "localPosts" @ local_posts <: E.int
- ]
-
- let t ({ software=software'; protocols; inbound_services; outbound_services; usage=usage';
- open_registrations; metadata; raw=_ } : Types.Nodeinfo.t) =
- obj [
- "version" @ "2.0" <: E.string;
- "software" @ software' <: software;
- "protocols" @ protocols <: E.list E.string;
- "services" @ obj [
- "inbound" @ inbound_services <: E.list E.string;
- "outbound" @ outbound_services <: E.list E.string;
- ] <: Fun.id;
- "usage" @ usage' <: usage;
- "openRegistrations" @ open_registrations <: E.bool;
- "metadata" @? metadata <: Fun.id;
- ]
-
-end
-
-
-(* module Build (S: sig
- * type user
- *
- * val owner: user -> Uri.t
- *
- * end) = struct
- *
- * end *)
diff --git a/lib/activitypub/readme.md b/lib/activitypub/readme.md
deleted file mode 100644
index 7282026..0000000
--- a/lib/activitypub/readme.md
+++ /dev/null
@@ -1,5 +0,0 @@
-# Activitypub Encoding
-
-This module defines functions to parse to and from activitypub JSONs from other servers.
-
-Taken from [Ocamlot](https://github.com/gopiandcode/ocamlot).
diff --git a/lib/activitypub/types.ml b/lib/activitypub/types.ml
deleted file mode 100644
index e4a56e9..0000000
--- a/lib/activitypub/types.ml
+++ /dev/null
@@ -1,245 +0,0 @@
-type yojson = Yojson.Safe.t
-let pp_yojson fmt vl = Yojson.Safe.pretty_print fmt vl
-let equal_yojson l r = Yojson.Safe.equal l r
-
-(** * Collections *)
-type 'a ordered_collection_page = {
- id: string;
- prev: string option;
- next: string option;
- is_ordered: bool;
- items: 'a list;
- part_of: string option;
- total_items: int option;
-} [@@deriving show, eq]
-
-
-type 'a ordered_collection = {
- id: string option;
- total_items: int;
- contents: [
- | `Items of (bool * 'a list)
- | `First of 'a ordered_collection_page
- ]
-} [@@deriving show, eq]
-
-(** * Events *)
-type 'a create = {
- id: string;
- actor: string;
- published: Ptime.t option;
- to_: string list;
- cc: string list;
- direct_message: bool;
- obj: 'a;
- raw: yojson;
-} [@@deriving show, eq]
-
-
-type 'a announce = {
- id: string;
- actor: string;
- published: Ptime.t option;
- to_: string list;
- cc: string list;
- obj: 'a;
- raw: yojson;
-} [@@deriving show, eq]
-
-
-type 'a accept = {
- id: string;
- actor: string;
- published: Ptime.t option;
- obj: 'a;
- raw: yojson;
-} [@@deriving show, eq]
-
-type 'a undo = {
- id: string;
- actor: string;
- published: Ptime.t option;
- obj: 'a;
- raw: yojson;
-} [@@deriving show, eq]
-
-type 'a delete = {
- id: string;
- actor: string;
- published: Ptime.t option;
- obj: 'a;
- raw: yojson;
-}
-[@@deriving show, eq]
-
-type 'a event = [
- `Create of 'a create
- | `Announce of 'a announce
- | `Accept of 'a accept
- | `Undo of 'a undo
- | `Delete of 'a delete
-] [@@deriving show, eq]
-
-
-(** * Objects *)
-type public_key = {
- id: string;
- owner: string;
- pem: string;
-} [@@deriving show, eq]
-
-type person = {
- id: string;
- name: string option;
- url: string option;
-
- preferred_username: string option;
-
- inbox: string;
- outbox: string;
-
- summary: string option;
-
- public_key: public_key;
-
- manually_approves_followers: bool;
-
- discoverable: bool;
- followers: string option;
- following: string option;
- icon: string option;
- raw: yojson;
-} [@@deriving show, eq]
-
-type follow = {
- id: string;
- actor: string;
- cc: string list;
- to_: string list;
- object_: string;
- state: [`Pending | `Cancelled ] option;
- raw: yojson;
-} [@@deriving show, eq]
-
-type tag = {
- ty: [`Mention | `Hashtag ];
- href: string;
- name: string;
-} [@@deriving show, eq]
-
-type attachment = {
- media_type: string option;
- name: string option;
- type_: string option;
- url: string;
-} [@@deriving show, eq]
-
-type note = {
- id: string;
- actor: string;
- attachment: attachment list;
- to_: string list;
- in_reply_to: string option;
- cc: string list;
- content: string;
- sensitive: bool;
- source: string option;
- summary: string option;
- published: Ptime.t option;
- tags: [ `Raw of yojson | `Value of tag ] list;
- raw: yojson;
-} [@@deriving show, eq]
-
-type block = {
- id: string;
- obj: string;
- published: Ptime.t option;
- actor: string;
- raw: yojson;
-} [@@deriving show, eq]
-
-type like = {
- id: string;
- actor: string;
- published: Ptime.t option;
- obj: string;
- raw: yojson;
-}
-[@@deriving show, eq]
-
-
-type core_obj = [
- `Person of person
- | `Follow of follow
- | `Note of note
- | `Block of block
- | `Like of like
- | `Link of string
-] [@@deriving show, eq]
-
-type core_event = core_obj event
-[@@deriving show, eq]
-
-type obj = [ core_obj | core_event ]
-[@@deriving show, eq]
-
-module Webfinger = struct
-
- type ty = [ `Html | `Json | `ActivityJson | `ActivityJsonLd ]
- [@@deriving show, eq]
-
- type link =
- | Self of ty * string
- | ProfilePage of ty * string
- | OStatusSubscribe of string
- [@@deriving show, eq]
-
- type query_result = {
- subject: string;
- aliases: string list;
- links: link list;
- }
- [@@deriving show, eq]
-
- let self_link query =
- query.links
- |> List.find_map (function
- | Self ((`ActivityJson | `ActivityJsonLd | `Json), url) -> Some (Uri.of_string url)
- | _ -> None)
-
-end
-
-module Nodeinfo = struct
-
- type software = {
- name: string;
- version: string;
- }
- [@@deriving show, eq]
-
- type usage_users = {
- total: int;
- active_month: int;
- active_half_year: int;
- }
- [@@deriving show, eq]
-
- type usage = {
- local_posts: int;
- users: usage_users;
- }
- [@@deriving show, eq]
-
- type t = {
- software: software;
- protocols: string list;
- inbound_services: string list;
- outbound_services: string list;
- usage: usage;
- open_registrations: bool;
- metadata: yojson option;
- raw: yojson;
- }
- [@@deriving show, eq]
-
-end