diff options
Diffstat (limited to '')
| -rw-r--r-- | bin/main.ml | 24 | ||||
| -rw-r--r-- | http/inbox.hurl | 6 | ||||
| -rw-r--r-- | lib/dune | 3 | ||||
| -rw-r--r-- | lib/post.ml | 21 | ||||
| -rw-r--r-- | lib/post.mli | 31 | ||||
| -rw-r--r-- | lib/user.ml | 29 | ||||
| -rw-r--r-- | readme.md | 4 | ||||
| -rw-r--r-- | wormhole.opam | 3 |
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", @@ -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 @@ -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: [ |