Formatting, support whitelist

4 files changed, 92 insertions, 75 deletions

diff --git a/bin/main.ml b/bin/main.ml
index 29dea84..579b334 100644
--- a/bin/main.ml
+++ b/bin/main.ml
@@ -2,20 +2,25 @@ open Wormhole
 
 let (fake_post : Post.t) =
   {
-    link = "https://mccd.space";
-    summary = "My personal blog";
-    tags = [ "cool"; "article" ];
-    published = "2020-01-01T00:00:00Z";
-    author = "Marc";
-  }
-
-let (fake_post_2 : Post.t) =
-  {
     link = "https://google.com";
-    summary = "Some other cool article that I just made";
-    tags = [ "cool"; "something" ];
-    published = "2020-01-02T00:00:00Z";
-    author = "Bob";
+    summary =
+      "<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>";
+    tags = [ "#goodie" ];
+    published = "2023-08-23";
+    author = "marcc.rooted";
+    author_link = "https://www.fosstodon.org/@marcc";
   }
 
 let webfinger =
@@ -109,38 +114,37 @@ let () =
          Dream.post "/inbox" (fun request ->
              let%lwt body = Dream.body request in
              Dream.log "Got body: %s" body;
-             let signature = Dream.headers request "signature" in
-             Dream.log "Got signature: %s" (String.concat " " signature);
              let message_object =
                Yojson.Safe.from_string body |> Post.mastodon_post_of_yojson
              in
              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";
-                 let pem = User.get_public_pem actor |> Result.to_option in
-                 let%lwt valid_request = Sig.verify_request pem request in
-                 (match valid_request with
-                 | Error e ->
-                     Dream.log "Error verifying request %s"
-                       Printexc.(to_string e);
-                     let code = Some 500 in
-                     Dream.json ?code "Invalid request"
-                 | Ok false ->
-                     Dream.log "Unauthorized request";
-                     let code = Some 501 in
-                     Dream.json ?code "Unauthorized"
-                 | Ok true ->
-                     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 "Added user"));
+             Dream.log "User found";
+             let pem = User.get_public_pem actor |> Result.to_option in
+             let%lwt valid_request = Sig.verify_request pem request in
+             let post =
+               message_object |> Post.post_of_mastodon_post (User.name actor)
+             in
+             let in_whitelist =
+               List.mem (Post.mastodon_actor message_object) actor_whitelist
+             in
+             match (valid_request, disable_auth, in_whitelist) with
+             | Error e, "false", _ ->
+                 Dream.log "Error verifying request %s" Printexc.(to_string e);
+                 let code = Some 500 in
+                 Dream.json ?code "Invalid request"
+             | Ok false, "false", _ ->
+                 Dream.log "Unauthorized request";
+                 let code = Some 401 in
+                 Dream.json ?code "Unauthorized"
+             | _, _, false ->
+                 Dream.log "Unauthorized request";
+                 let code = Some 401 in
+                 Dream.json ?code "Unauthorized, not in whitelist"
+             | _, _, _ ->
+                 post |> Post.add;
+                 message_object |> Post.yojson_of_mastodon_post
+                 |> Yojson.Safe.to_string |> Dream.log "Added post %s";
+                 Dream.json "Added user");
        ]
diff --git a/bin/template.eml b/bin/template.eml
index 96e4f62..1a3c888 100644
--- a/bin/template.eml
+++ b/bin/template.eml
@@ -6,6 +6,11 @@ let render (posts: Post.t list) =
   <script src="https://unpkg.com/htmx.org@1.9.9"></script>

   <link

     rel="stylesheet"

+    href="/static/pixeloid-sans.ttf"

+  />

+  <link rel="stylesheet" href="static/main.css" />

+  <link

+    rel="stylesheet"

     href="https://cdn.jsdelivr.net/npm/@shoelace-style/shoelace@2.12.0/cdn/themes/light.css"

   />

   <script

@@ -15,23 +20,31 @@ let render (posts: Post.t list) =
   <head>

     <title>Sensemaking Galaxy</title>

   </head>

-  <body style="display:flex; flex-direction:column; align-items:center; background: rgb(23,7,40); background: radial-gradient(circle, rgba(23,7,40,1) 0%, rgba(0,0,0,1) 50%, rgba(12,21,63,1) 100%);">

-    <h1 style="color: white; margin-top: 3rem">Sensemaking Galaxy</h1>

-    <div>

-      <sl-button variant="text" size="medium">rss</sl-button>

+  <body style="display:flex; flex-direction:column; align-items:center;">

+    <div style="display:flex;margin-top: 3rem; padding: 6px; gap: 3px; margin-bottom:

+3rem;">

+      <h1 class="intro" style="color: white; letter-spacing: .5rem;">SENSEMAKING GALAXY</h1>

+      <a href="/feed.xml">

+        <img src="/static/rss.svg" alt="rss"  style="height: 20px; margin-top: 2rem;" />

+      </a>

     </div>

-    <p style="color: white; margin-bottom: 2rem">Links that have ended up in this Galaxy were sent through space

-and time by the Sensemaking Wormhole.</p>

-%    posts |> List.iter begin fun { author; link; summary; tags; _ } ->

-    <div>

-      <sl-card style="min-width: 400px; max-width: 600px; margin: 10px">

+    <sl-card style="margin-bottom: 4rem; min-width: 400px; max-width:400px;" class="space-intro">

+      <p>Haling from other points in time and space, these posts traveled 

+here from across the cybernet via a Mastodon Wormhole.</p>

+      <a href="https://git.mccd.space/wormhole" style="color: var(--lavender-grey)">Source code</a>

+    </sl-card>

+%    posts |> List.iter begin fun { published; author; author_link; summary; tags; _ } ->

+    <div style="margin-bottom: 1.0rem;">

+      <sl-card class="space-card" style="min-width: 400px; max-width: 600px; margin: 10px; ">

+        <div slot="header" style="display:flex; gap: 5px;">

+          <%s published %>

+          <a href=<%s author_link %>><%s author %></a>

+        </div>

         <div style="display:flex; flex-direction:column; gap: 10px">

-          <%s summary %>

-          <sl-button  size="small" href=<%s link %>>Link (<%s Post.get_tld link %>)</sl-button>

+          <%s! summary %>

         </div>

         

         <div slot="footer" style="display:flex; flex-direction:row; justify-content:space-between">

-          Submitted by: <%s author %>

           <div style="display:flex; flex-direction:row; gap: 3px">

 %         tags |> List.iter begin fun tag ->

             <sl-tag size="small"><%s tag %></sl-tag>

@@ -40,5 +53,7 @@ and time by the Sensemaking Wormhole.</p>
         </div>

     </div>

 %    end;

+    <div class="space"></div>

   </body>

+    

 </html>

diff --git a/lib/post.ml b/lib/post.ml
index 5c3d494..dbca936 100644
--- a/lib/post.ml
+++ b/lib/post.ml
@@ -48,7 +48,11 @@ type mastodon_tag = {
 }
 [@@deriving yojson] [@@yojson.allow_extra_fields]
 
-type mastodon_object = { tag : mastodon_tag list; url : string }
+type mastodon_object = {
+  tag : mastodon_tag list;
+  url : string;
+  content : string;
+}
 [@@deriving yojson] [@@yojson.allow_extra_fields]
 
 type mastodon_post = {
@@ -61,7 +65,7 @@ type mastodon_post = {
 let mastodon_actor post = post.actor
 
 let post_of_mastodon_post actor_name = function
-  | { published; obj = { tag; url }; _ } ->
+  | { published; obj = { tag; url; content }; _ } ->
       let tags =
         List.filter_map
           (fun { name; kind; _ } ->
@@ -70,18 +74,14 @@ let post_of_mastodon_post actor_name = function
             if kind = "Hashtag" then Some name else None)
           tag
       in
-      { link = url; summary = published; tags; published; author = actor_name }
+      {
+        link = url;
+        summary = content;
+        tags;
+        published;
+        author = actor_name;
+        author_link = url;
+      }
 
 let get_tld (link : string) =
   Uri.of_string link |> Uri.host_with_default ~default:""
-
-let db = ref []
-
-let add (entry : t) =
-  db := entry :: !db;
-  print_endline (entry.link ^ " added to db");
-  print_endline ("New db size: " ^ string_of_int (List.length !db))
-
-let get_all () =
-  print_endline ("db size: " ^ string_of_int (List.length !db));
-  !db
diff --git a/lib/user.ml b/lib/user.ml
index f0ac7cf..ba802c0 100644
--- a/lib/user.ml
+++ b/lib/user.ml
@@ -17,14 +17,12 @@ 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%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
+  body
 
 let get_public_pem user =
   user.public_key.public_key_pem |> Cstruct.of_string