Add user

8 files changed, 73 insertions, 48 deletions

diff --git a/bin/main.ml b/bin/main.ml
index dcd24aa..67c9786 100644
--- a/bin/main.ml
+++ b/bin/main.ml
@@ -21,7 +21,7 @@ let (fake_post_2 : Post.t) =
 let webfinger =
   {|
 {
-	"subject": "acct:blackhole@galaxy.mccd.space",
+	"subject": "acct:wormhole@galaxy.mccd.space",
 
 	"links": [
 		{
@@ -43,7 +43,7 @@ let actor =
 
   "id": "https://galaxy.mccd.space/actor",
   "type": "Person",
-  "preferredUsername": "blackhole",
+  "preferredUsername": "wormhole",
   "inbox": "https://galaxy.mccd.space/inbox",
 
   "publicKey": {
@@ -86,8 +86,20 @@ let () =
              let message_object =
                Yojson.Safe.from_string body |> Post.mastodon_post_of_yojson
              in
-             message_object |> Post.yojson_of_mastodon_post
-             |> Yojson.Safe.to_string |> Dream.log "Added post %s";
-             message_object |> Post.post_of_mastodon_post |> Post.add;
-             Dream.json "{}");
+             let%lwt actor =
+               User.get_user (Post.mastodon_actor message_object)
+             in
+             match actor with
+             | Error e ->
+                 Dream.log "User not found %s" (Printexc.to_string e);
+                 let code = Some 400 in
+                 Dream.json ?code "User not found"
+             | Ok actor ->
+                 Dream.log "User found";
+                 message_object
+                 |> Post.post_of_mastodon_post (User.name actor)
+                 |> Post.add;
+                 message_object |> Post.yojson_of_mastodon_post
+                 |> Yojson.Safe.to_string |> Dream.log "Added post %s";
+                 Dream.json "{}");
        ]
diff --git a/http/inbox.hurl b/http/inbox.hurl
index adb2d0e..be3da70 100644
--- a/http/inbox.hurl
+++ b/http/inbox.hurl
@@ -38,16 +38,16 @@ POST http://localhost:8080/inbox
     "atomUri": "https://fosstodon.org/users/marcc/statuses/111506250224920551",
     "inReplyToAtomUri": null,
     "conversation": "tag:fosstodon.org,2023-12-01:objectId=165401029:objectType=Conversation",
-    "content": "<p><span class=\"h-card\" translate=\"no\"><a href=\"https://galaxy.mccd.space/actor\" class=\"u-url mention\">@<span>blackhole</span></a></span>   </p><p><a href=\"https://google.com\" target=\"_blank\" rel=\"nofollow noopener noreferrer\" translate=\"no\"><span class=\"invisible\">https://</span><span class=\"\">google.com</span><span class=\"invisible\"></span></a></p><p>This is a place on the web where you can search for things</p><p><a href=\"https://fosstodon.org/tags/goodie\" class=\"mention hashtag\" rel=\"tag\">#<span>goodie</span></a> <a href=\"https://fosstodon.org/tags/othergoodie\" class=\"mention hashtag\" rel=\"tag\">#<span>othergoodie</span></a></p>",
+    "content": "<p><span class=\"h-card\" translate=\"no\"><a href=\"https://galaxy.mccd.space/actor\" class=\"u-url mention\">@<span>wormhole</span></a></span>   </p><p><a href=\"https://google.com\" target=\"_blank\" rel=\"nofollow noopener noreferrer\" translate=\"no\"><span class=\"invisible\">https://</span><span class=\"\">google.com</span><span class=\"invisible\"></span></a></p><p>This is a place on the web where you can search for things</p><p><a href=\"https://fosstodon.org/tags/goodie\" class=\"mention hashtag\" rel=\"tag\">#<span>goodie</span></a> <a href=\"https://fosstodon.org/tags/othergoodie\" class=\"mention hashtag\" rel=\"tag\">#<span>othergoodie</span></a></p>",
     "contentMap": {
-      "en": "<p><span class=\"h-card\" translate=\"no\"><a href=\"https://galaxy.mccd.space/actor\" class=\"u-url mention\">@<span>blackhole</span></a></span>   </p><p><a href=\"https://google.com\" target=\"_blank\" rel=\"nofollow noopener noreferrer\" translate=\"no\"><span class=\"invisible\">https://</span><span class=\"\">google.com</span><span class=\"invisible\"></span></a></p><p>This is a place on the web where you can search for things</p><p><a href=\"https://fosstodon.org/tags/goodie\" class=\"mention hashtag\" rel=\"tag\">#<span>goodie</span></a> <a href=\"https://fosstodon.org/tags/othergoodie\" class=\"mention hashtag\" rel=\"tag\">#<span>othergoodie</span></a></p>"
+      "en": "<p><span class=\"h-card\" translate=\"no\"><a href=\"https://galaxy.mccd.space/actor\" class=\"u-url mention\">@<span>wormhole</span></a></span>   </p><p><a href=\"https://google.com\" target=\"_blank\" rel=\"nofollow noopener noreferrer\" translate=\"no\"><span class=\"invisible\">https://</span><span class=\"\">google.com</span><span class=\"invisible\"></span></a></p><p>This is a place on the web where you can search for things</p><p><a href=\"https://fosstodon.org/tags/goodie\" class=\"mention hashtag\" rel=\"tag\">#<span>goodie</span></a> <a href=\"https://fosstodon.org/tags/othergoodie\" class=\"mention hashtag\" rel=\"tag\">#<span>othergoodie</span></a></p>"
     },
     "attachment": [],
     "tag": [
       {
         "type": "Mention",
         "href": "https://galaxy.mccd.space/actor",
-        "name": "@blackhole@galaxy.mccd.space"
+        "name": "@wormhole@galaxy.mccd.space"
       },
       {
         "type": "Hashtag",
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
diff --git a/readme.md b/readme.md
index 0a29cde..fd9087c 100644
--- a/readme.md
+++ b/readme.md
@@ -17,13 +17,13 @@ You'll need `libev` and `openssl`.
 ## Running
 
 ```
-dune exec --watch --root . ./server.exe
+dune exec --watch --root . wormhole
 ```
 
 ## Build
 
 ```
-opam build
+opam install . --deps-only
 opam exec -- dune build
 ```
 
diff --git a/wormhole.opam b/wormhole.opam
index 77342ae..f26a552 100644
--- a/wormhole.opam
+++ b/wormhole.opam
@@ -11,9 +11,10 @@ doc: "https://url/to/documentation"
 bug-reports: "https://github.com/username/reponame/issues"
 depends: [
   "ocaml"
-  "dream"
   "dune" {>= "3.11"}
   "ppx_yojson_conv"
+  "cohttp"
+  "cohttp-lwt-unix"
   "odoc" {with-doc}
 ]
 build: [