diff options
Diffstat (limited to '')
| -rw-r--r-- | lib/activitypub/activitypub.ml | 5 | ||||
| -rw-r--r-- | lib/activitypub/common.ml | 47 | ||||
| -rw-r--r-- | lib/activitypub/constants.ml | 49 | ||||
| -rw-r--r-- | lib/activitypub/decode.ml | 352 | ||||
| -rw-r--r-- | lib/activitypub/dune | 3 | ||||
| -rw-r--r-- | lib/activitypub/encode.ml | 303 | ||||
| -rw-r--r-- | lib/activitypub/readme.md | 5 | ||||
| -rw-r--r-- | lib/activitypub/types.ml | 245 |
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 |