diff --git a/mehari-eio/mehari_eio.ml b/mehari-eio/mehari_eio.ml index c88f6bb..67be021 100644 --- a/mehari-eio/mehari_eio.ml +++ b/mehari-eio/mehari_eio.ml @@ -26,16 +26,20 @@ type middleware = handler -> handler type route = Router.route type rate_limiter = RateLimiter.t -let make_rate_limit = RateLimiter.make let set_log_lvl = Logger.set_level let logger = Logger.logger let debug = Logger.debug let info = Logger.info let warning = Logger.warning let error = Logger.error +let no_middleware = Router.no_middleware +let pipeline = Router.pipeline let router = Router.router let route = Router.route let scope = Router.scope -let virtual_hosts = Router.virtual_hosts +let no_route = Router.no_route + let response_document = File.response_document +let virtual_hosts = Router.virtual_hosts +let make_rate_limit = RateLimiter.make let run = Server.run diff --git a/mehari-mirage/mehari_mirage.ml b/mehari-mirage/mehari_mirage.ml index 30ebc1e..252de76 100644 --- a/mehari-mirage/mehari_mirage.ml +++ b/mehari-mirage/mehari_mirage.ml @@ -59,16 +59,21 @@ module Make Mehari.response_gemtext ?charset ?lang g |> IO.return let respond_raw g = Mehari.response_raw g |> IO.return - let make_rate_limit = RateLimiter.make let set_log_lvl = Logger.set_level let logger = Logger.logger let debug = Logger.debug let info = Logger.info let warning = Logger.warning let error = Logger.error + + let no_middleware = Router.no_middleware + let pipeline = Router.pipeline + let router = Router.router let route = Router.route let scope = Router.scope + let no_route = Router.no_route let virtual_hosts = Router.virtual_hosts + let make_rate_limit = RateLimiter.make let run = Server.run end diff --git a/mehari/mehari.ml b/mehari/mehari.ml index 3ae8b4c..363fbcc 100644 --- a/mehari/mehari.ml +++ b/mehari/mehari.ml @@ -47,6 +47,8 @@ module type NET = sig type handler = addr Request.t -> Response.t IO.t type middleware = handler -> handler + val no_middleware : middleware + val pipeline : middleware list -> middleware val router : route list -> handler val route : @@ -60,6 +62,8 @@ module type NET = sig val scope : ?rate_limit:rate_limiter -> ?mw:middleware -> string -> route list -> route + val no_route : route + val make_rate_limit : ?period:int -> int -> [ `Second | `Minute | `Hour | `Day ] -> rate_limiter diff --git a/mehari/mehari.mli b/mehari/mehari.mli index b547838..e44dff1 100644 --- a/mehari/mehari.mli +++ b/mehari/mehari.mli @@ -59,7 +59,6 @@ assert ([ quote "hello\nworld" ] = [ quote "hello"; text "world" ]) val heading : [ `H1 | `H2 | `H3 ] -> string -> line val list_item : string -> line val quote : string -> line - val pp : Format.formatter -> t -> unit end @@ -264,7 +263,26 @@ module type NET = sig type middleware = handler -> handler (** Middlewares take a {!type:handler}, and run some code before or - after — producing a “bigger” {!type:handler}. *) + after — producing a “bigger” {!type:handler}. See + {!section-middleware}. *) + + (** {1:middleware} Middleware *) + + val no_middleware : middleware + (** Does nothing but call its inner handler. Useful for disabling middleware + conditionally during application startup: + + {@ocaml[ +if development then + my_middleware +else + Mehari.no_middleware +]} *) + + val pipeline : middleware list -> middleware + (** Combines a list of middlewares into one, such that these two lines are + equivalent: [Mehari.pipeline [ mw1 ; mw2 ] @@ handler] + [ mw1 @@ mw2 @@ handler]. *) (** {1:routing Routing} *) @@ -290,6 +308,11 @@ module type NET = sig (** [scope ~rate_limit ~mw prefix routes] groups [routes] under the path [prefix], [rate_limit] and [mw]. *) + val no_route : route + (** A dummy value of type {!type:route} that is completely ignored by the + router. Useful for disabling routes conditionally during application + start. *) + (** {1:rate_limit Rate limit} *) val make_rate_limit : @@ -433,6 +456,8 @@ module Private : sig type handler = addr Handler.Make(IO).t type middleware = handler -> handler + val no_middleware : middleware + val pipeline : middleware list -> middleware val router : route list -> handler val route : @@ -450,6 +475,7 @@ module Private : sig route list -> route + val no_route : route val virtual_hosts : (string * handler) list -> handler end diff --git a/mehari/router_impl.ml b/mehari/router_impl.ml index 246ceff..54ca90c 100644 --- a/mehari/router_impl.ml +++ b/mehari/router_impl.ml @@ -7,6 +7,8 @@ module type S = sig type handler = addr Handler.Make(IO).t type middleware = handler -> handler + val no_middleware : middleware + val pipeline : middleware list -> middleware val router : route list -> handler val route : @@ -20,6 +22,7 @@ module type S = sig val scope : ?rate_limit:rate_limiter -> ?mw:middleware -> string -> route list -> route + val no_route : route val virtual_hosts : (string * handler) list -> handler end @@ -42,6 +45,8 @@ module Make (RateLimiter : Rate_limiter_impl.S) (Logger : Logger_impl.S) : rate_limit : RateLimiter.t option; } + let no_route = [] + let route ?rate_limit ?(mw = Fun.id) ?(typ = `Raw) r handler = [ { route = (typ, r); handler = mw handler; rate_limit } ] @@ -98,6 +103,11 @@ module Make (RateLimiter : Rate_limiter_impl.S) (Logger : Logger_impl.S) : handler req | Some resp -> resp)) + let scope ?rate_limit ?(mw = Fun.id) prefix routes = + List.concat routes + |> List.map (fun { route = typ, r; handler; _ } -> + { route = (typ, prefix ^ r); handler = mw handler; rate_limit }) + let virtual_hosts domains_handler req = let req_host = Request.uri req |> Uri.host @@ -107,8 +117,8 @@ module Make (RateLimiter : Rate_limiter_impl.S) (Logger : Logger_impl.S) : | None -> assert false (* Guaranteed by [Protocol.make_request]. *) | Some (_, handler) -> handler req - let scope ?rate_limit ?(mw = Fun.id) prefix routes = - List.concat routes - |> List.map (fun { route = typ, r; handler; _ } -> - { route = (typ, prefix ^ r); handler = mw handler; rate_limit }) + let no_middleware h req = h req + + let rec pipeline mws handler = + match mws with [] -> handler | m :: ms -> m (pipeline ms handler) end