diff options
| -rw-r--r-- | bin/main.ml | 32 | ||||
| -rw-r--r-- | lib/post.ml | 33 | ||||
| -rw-r--r-- | lib/xml.ml | 54 | ||||
| -rw-r--r-- | lib/xml.mli | 13 |
4 files changed, 109 insertions, 23 deletions
diff --git a/bin/main.ml b/bin/main.ml index 4d12cee..29dea84 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -54,18 +54,46 @@ let actor = } |} +let actor_whitelist = + [ + "https://fosstodon.org/users/marcc"; + "https://universeodon.com/users/icecreambook"; + "https://mastodon.social/users/ronent"; + "https://graphics.social/users/theohonohan"; + ] + let () = - Post.add fake_post; - Post.add fake_post_2; let port = Sys.getenv_opt "PORT" |> Option.map int_of_string |> Option.value ~default:8080 in let env = Sys.getenv_opt "ENV" |> Option.value ~default:"PROD" in + let disable_auth = + Sys.getenv_opt "DISABLE_AUTH" |> Option.value ~default:"false" + in let interface = if env = "DEV" then "localhost" else "0.0.0.0" in + if env = "DEV" then Post.add fake_post; + if env = "DEV" then Post.add fake_post; + if env = "DEV" then Post.add fake_post; + if env = "DEV" then Post.add fake_post; Dream.run ~port ~interface @@ Dream.logger @@ Dream.router [ + Dream.get "/static/**" (Dream.static "./static"); + Dream.get "/feed.xml" (fun _ -> + let posts = Post.get_all () in + let maybe_latest_post = Post.latest_post () in + match maybe_latest_post with + | Some latest_post -> + let rss_posts = posts |> List.map Post.to_rss_entry in + let rss = + Xml.format_rss "https://galaxy.mccd.space" + (Post.published latest_post) + rss_posts + in + Dream.respond rss + ~headers:[ ("Content-Type", "application/rss+xml") ] + | None -> Dream.html "No posts hav been published!"); Dream.get "/actor" (fun _ -> Dream.log "Sending actor"; Dream.respond actor diff --git a/lib/post.ml b/lib/post.ml index 744e296..5c3d494 100644 --- a/lib/post.ml +++ b/lib/post.ml @@ -6,8 +6,41 @@ type t = { tags : string list; published : string; author : string; + author_link : string; } +let published t = t.published + +(* RSS *) + +let to_rss_entry post = + Xml.tag "entry" [] + [ + Xml.tag "title" [] [ Xml.entry (post.author ^ " - " ^ post.link) ]; + Xml.tag "id" [] [ Xml.entry post.link ]; + Xml.tag "updated" [] [ Xml.entry post.published ]; + Xml.tag "summary" + [ ("xml:lang", "\"en\""); ("type", "\"html\"") ] + [ Xml.entry post.summary ]; + ] + +(* DB *) + +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 + +let latest_post () = match !db with [] -> None | x :: _ -> Some x + +(* Mastodon integration *) + type mastodon_tag = { kind : string; [@key "type"] name : string; @@ -1,10 +1,48 @@ -type xml = Tag of string * xml list | String of string +type attribute = string * string -let tag name body = Tag (name, body) -let format, format_list = Format.(fprintf, pp_print_list) +type xml = + | Tag of string * attribute list * xml list + | String of string + | Closing_tag of string * attribute list -let rec format_xml f = function - | Tag (name, body) -> - let format_body = format_list format_xml in - format f "@[<hv 3><%s>@,%a@;<0 -3></%s>@]" name format_body body name - | String text -> format f "%s" text +let tag name attributes body = Tag (name, attributes, body) +let entry value = String value +let closing_tag name attributes = Closing_tag (name, attributes) + +let format_attributes attributes = + let format_attribut (name, value) = Printf.sprintf " %s=\"%s\"" name value in + String.concat "" (List.map format_attribut attributes) + +let rec format = function + | Tag (name, attributes, body) -> + let body = List.map format body in + String.concat "" + [ + "<"; + name; + " "; + format_attributes attributes; + ">"; + String.concat "" body; + "</"; + name; + ">"; + ] + | String text -> text + | Closing_tag (name, attributes) -> + String.concat "" [ "<"; name; " "; format_attributes attributes; "/>" ] + +let format_rss host_name last_updated entries = + tag "feed" + [ ("xml:base", host_name) ] + [ + tag "title" [] [ entry "Sensemaking Galaxy" ]; + tag "subtitle" [] [ entry "A collection of sensemaking links" ]; + closing_tag "link" [ ("href", host_name ^ "/feed.xml"); ("rel", "self") ]; + closing_tag "link" [ ("href", host_name) ]; + tag "id" [] [ entry host_name ]; + tag "updated" [] [ entry last_updated ]; + tag "author" [] [ tag "name" [] [ entry "Sensemaking Galaxy" ] ]; + tag "entry" [] entries; + ] + |> format diff --git a/lib/xml.mli b/lib/xml.mli deleted file mode 100644 index e1d3eb9..0000000 --- a/lib/xml.mli +++ /dev/null @@ -1,13 +0,0 @@ -type xml = Tag of string * xml list | String of string - -val tag : string -> xml list -> xml -val format : Format.formatter -> ('a, Format.formatter, unit) format -> 'a - -val format_list : - ?pp_sep:(Format.formatter -> unit -> unit) -> - (Format.formatter -> 'a -> unit) -> - Format.formatter -> - 'a list -> - unit - -val format_xml : Format.formatter -> xml -> unit |