aboutsummaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
authorMarc Coquand <marcc@fastmail.fr>2023-12-02 11:25:36 -0600
committerMarc Coquand <marcc@fastmail.fr>2023-12-02 11:25:36 -0600
commit189179574d847e8e9662cf78804ce9371fac988d (patch)
tree0cc2b8c27fe8cf59d4724100d8b95085fab6432d /lib
parent4fe8c79ce03e12be04b0d928b65b1a7d475f4458 (diff)
downloadwormhole-189179574d847e8e9662cf78804ce9371fac988d.tar.gz
wormhole-189179574d847e8e9662cf78804ce9371fac988d.tar.bz2
wormhole-189179574d847e8e9662cf78804ce9371fac988d.zip
Add user
Diffstat (limited to 'lib')
-rw-r--r--lib/dune3
-rw-r--r--lib/post.ml21
-rw-r--r--lib/post.mli31
-rw-r--r--lib/user.ml29
4 files changed, 48 insertions, 36 deletions
diff --git a/lib/dune b/lib/dune
index 2bcd146..441cc53 100644
--- a/lib/dune
+++ b/lib/dune
@@ -1,5 +1,4 @@
(library
(name wormhole)
- (libraries uri)
- (modules Post)
+ (libraries uri cohttp cohttp-lwt-unix)
(preprocess (pps lwt_ppx ppx_yojson_conv)))
diff --git a/lib/post.ml b/lib/post.ml
index 232d9a7..3b63a11 100644
--- a/lib/post.ml
+++ b/lib/post.ml
@@ -25,10 +25,25 @@ type mastodon_post = {
}
[@@deriving yojson] [@@yojson.allow_extra_fields]
-let post_of_mastodon_post = function
+let mastodon_actor post = post.actor
+
+let post_of_mastodon_post actor_name = function
| { actor; published; obj = { tag } } ->
- let tags = List.map (fun { name; _ } -> name) tag in
- { link = actor; summary = published; tags; published; author = actor }
+ let tags =
+ List.filter_map
+ (fun { name; kind; _ } ->
+ (* This would normally be filtered with yojson, but I couldn't get
+ it to work *)
+ if kind = "Hashtag" then Some name else None)
+ tag
+ in
+ {
+ link = actor;
+ summary = published;
+ tags;
+ published;
+ author = actor_name;
+ }
let get_tld (link : string) =
Uri.of_string link |> Uri.host_with_default ~default:""
diff --git a/lib/post.mli b/lib/post.mli
deleted file mode 100644
index 9bf32ae..0000000
--- a/lib/post.mli
+++ /dev/null
@@ -1,31 +0,0 @@
-type t = {
- link : string;
- summary : string;
- tags : string list;
- published : string;
- author : string;
-}
-
-type mastodon_tag = { kind : string; name : string; href : string }
-
-val mastodon_tag_of_yojson : Yojson.Safe.t -> mastodon_tag
-val yojson_of_mastodon_tag : mastodon_tag -> Yojson.Safe.t
-
-type mastodon_object = { tag : mastodon_tag list }
-
-val mastodon_object_of_yojson : Yojson.Safe.t -> mastodon_object
-val yojson_of_mastodon_object : mastodon_object -> Yojson.Safe.t
-
-type mastodon_post = {
- actor : string;
- published : string;
- obj : mastodon_object;
-}
-
-val mastodon_post_of_yojson : Yojson.Safe.t -> mastodon_post
-val yojson_of_mastodon_post : mastodon_post -> Yojson.Safe.t
-val post_of_mastodon_post : mastodon_post -> t
-val get_tld : string -> string
-val db : t list ref
-val add : t -> unit
-val get_all : unit -> t list
diff --git a/lib/user.ml b/lib/user.ml
new file mode 100644
index 0000000..00cd33f
--- /dev/null
+++ b/lib/user.ml
@@ -0,0 +1,29 @@
+open Ppx_yojson_conv_lib.Yojson_conv.Primitives
+open Cohttp
+open Cohttp_lwt_unix
+open Lwt
+
+type public_key = {
+ id : string;
+ owner : string;
+ public_key_prem : string; [@key "publicKeyPem"]
+}
+[@@deriving yojson] [@@yojson.allow_extra_fields]
+
+type t = { name : string; public_key : public_key [@key "publicKey"] }
+[@@deriving yojson] [@@yojson.allow_extra_fields]
+
+let activity_header =
+ Some (Header.of_list [ ("Accept", "application/activity+json") ])
+
+let get_user actor_url =
+ try%lwt
+ let%lwt _, body =
+ Client.get ?headers:activity_header (Uri.of_string actor_url)
+ in
+ body |> Cohttp_lwt.Body.to_string >|= fun body ->
+ let body = Yojson.Safe.from_string body |> t_of_yojson in
+ Ok body
+ with exn -> Lwt.return (Error exn)
+
+let name user = user.name