Skip to content
Permalink
Browse files

More cleanup

  • Loading branch information...
tsileo committed Apr 28, 2019
1 parent 97d792e commit 7fa38d56ab5d5861d5282f1fcb4cb0ae9a404334
Showing with 50 additions and 24 deletions.
  1. +14 −13 bin/app.ml
  2. +1 −1 lib/config.ml
  3. +3 −1 lib/entry.ml
  4. +2 −0 lib/microformats.ml
  5. +1 −1 lib/micropub.ml
  6. lib/{util.ml → utils.ml}
  7. +21 −0 lib/websub.ml
  8. +1 −1 test/test.ml
@@ -8,7 +8,7 @@ open Entriespub
open Entriespub.Entry
open Entriespub.Micropub
open Entriespub.Microformats
open Entriespub.Util
open Entriespub.Utils
open Entriespub.Config

let is_multipart_regexp = Str.regexp "multipart/.*"
@@ -25,14 +25,14 @@ let head (r : string) (ep : Yurt.endpoint) (s : Server.server) =

(* Output a JSON error *)
let json_error code msg status =
let headers = Header.init () in
Header.add headers "X-Powered-By" "entries.pub";
Header.add headers "Content-Type" "application/json";
let headers = Header.init ()
|> set_content_type "application/json" in

Server.json (build_error code msg) ~status ~headers

(* Call the token endpoint in order to verify the token validity *)
let check_auth req =
(* Get the bearer token from the incoming request *)
let auth = Yurt_util.unwrap_option_default (Header.get req.Request.headers "Authorization") "" in
if auth = "" then
Lwt.return false
@@ -41,6 +41,7 @@ let check_auth req =
Header.init ()
|> fun h -> Header.add h "Authorization" auth in

(* And forward it to the token endpoint *)
Client.get ~headers token_endpoint >>= fun (resp, body) ->
match resp with
| { Response.status = `OK } -> Lwt.return true
@@ -78,7 +79,7 @@ server "127.0.0.1" 7888
] in
let out = Mustache.render atom_tpl dat in
let headers = Header.init ()
|> Util.set_content_type "application/xml"
|> set_content_type "application/xml"
|> fun h -> Header.add h "Link" "</atom.xml>; rel=\"self\""
|> fun h -> Header.add h "Link" ("<" ^ websub_endpoint ^ ">; rel=\"hub\"") in
string out ~headers)
@@ -87,7 +88,7 @@ server "127.0.0.1" 7888
>| head "/" (fun req params body ->
log_req req;
let headers = Header.init ()
|> Util.add_links base_url in
|> add_links base_url in
string "" ~headers)

(* Index *)
@@ -103,8 +104,8 @@ server "127.0.0.1" 7888
] in
let out = Mustache.render html_tpl dat in
let headers = Header.init ()
|> Util.set_content_type Util.text_html
|> Util.add_links base_url in
|> set_content_type text_html
|> add_links base_url in
string out ~headers)

(* Micropub endpoint *)
@@ -145,7 +146,7 @@ server "127.0.0.1" 7888
match some_stored with
| Some stored ->
let headers = Header.init ()
|> Util.add_links base_url in
|> add_links base_url in
string "" ~headers
| None ->
(* 404 *)
@@ -170,8 +171,8 @@ server "127.0.0.1" 7888
] in
let out = Mustache.render html_tpl dat in
let headers = Header.init ()
|> Util.set_content_type Util.text_html
|> Util.add_links base_url in
|> set_content_type text_html
|> add_links base_url in
(string out ~headers)
| None ->
(* Return a 404 *)
@@ -183,8 +184,8 @@ server "127.0.0.1" 7888
] in
let out = Mustache.render html_tpl dat in
let headers = Header.init ()
|> Util.set_content_type Util.text_html
|> Util.add_links base_url in
|> set_content_type text_html
|> add_links base_url in
string out ~headers ~status:404)

(* Run it *)
@@ -1,7 +1,7 @@
open Lwt.Infix
open Lwt
open Yurt
include Entriespub.Util
open Utils

module Store = Irmin_unix.Git.FS.KV(Irmin.Contents.String)

@@ -1,9 +1,11 @@
open Lwt.Infix
open Lwt
open Yurt
open Util
include Cohttp_lwt_unix.Server

open Config
open Util
open Utils

(* Slugify replaces whitespaces by dashes, lowecases and remove any non alphanum chars. *)
let slugify k =
@@ -5,6 +5,8 @@ include Cohttp.Link
open Cohttp
include Soup

open Utils


let parse url soup target =
let hcard_soup = try
@@ -5,7 +5,7 @@ include Cohttp_lwt_unix.Server

open Config
open Entry
open Util
open Utils

let build_url uid slug =
base_url ^ "/" ^ uid ^ "/" ^ slug
@@ -32,19 +32,19 @@ let invalid_request_error desc =
build_error "invalid_request" desc

(* Return the first item of the given list or a data *)
let jform_field jdata k default =
let jdata_field jdata k default =
if Ezjsonm.(mem jdata k) then
let items = Ezjsonm.(get_strings (find jdata k)) in
match items with
| [] -> default
| t :: _ -> t
Ezjsonm.(get_string (find jdata k))
else
default

(* Return the first item of the given list or a data *)
let jdata_field jdata k default =
let jform_field jdata k default =
if Ezjsonm.(mem jdata k) then
Ezjsonm.(get_string (find jdata k))
let items = Ezjsonm.(get_strings (find jdata k)) in
match items with
| [] -> default
| t :: _ -> t
else
default

@@ -0,0 +1,21 @@
open Lwt.Infix
open Yurt
open Cohttp
open Soup

open Entriespub

(* Notify the WebSub hub that a resource has been updated *)
let ping updated =
(* Ensure a WebSub endpoint is set *)
if Config.websub_endpoint = "" then Lwt.return true else
(* Do the WebSub ping *)
let params = ["hub.mode",["publish"]; "hub.url",[updated]] in
Client.post_form ~params Config.websub_endpoint >>= fun (resp, body) ->
let code =
resp
|> Response.status
|> Code.code_of_status
in
let out = if code = 204 then true else false in
out |> Lwt.return
@@ -1,4 +1,4 @@
open Entriespub.Util
open Entriespub.Utils

let test_get_uid_and_slug = [
"get_uid_and_slug", `Quick, (fun () ->

0 comments on commit 7fa38d5

Please sign in to comment.
You can’t perform that action at this time.