diff options
Diffstat (limited to 'bs5/server/middleware')
-rw-r--r-- | bs5/server/middleware/counter.ml | 5 | ||||
-rw-r--r-- | bs5/server/middleware/dune | 5 | ||||
-rw-r--r-- | bs5/server/middleware/logs.ml | 12 | ||||
-rw-r--r-- | bs5/server/middleware/promise.ml | 12 |
4 files changed, 34 insertions, 0 deletions
diff --git a/bs5/server/middleware/counter.ml b/bs5/server/middleware/counter.ml new file mode 100644 index 0000000..85aa26f --- /dev/null +++ b/bs5/server/middleware/counter.ml @@ -0,0 +1,5 @@ +let count = ref 0 + +let count_requests inner_handler request = + count := !count + 1; + inner_handler request diff --git a/bs5/server/middleware/dune b/bs5/server/middleware/dune new file mode 100644 index 0000000..56d764f --- /dev/null +++ b/bs5/server/middleware/dune @@ -0,0 +1,5 @@ +(library + (name middleware) + (libraries dream lwt) + (preprocess + (pps lwt_ppx))) diff --git a/bs5/server/middleware/logs.ml b/bs5/server/middleware/logs.ml new file mode 100644 index 0000000..6925ca4 --- /dev/null +++ b/bs5/server/middleware/logs.ml @@ -0,0 +1,12 @@ +let detailed_logger inner_handler request = + let method_str = Dream.method_to_string (Dream.method_ request) in + let path = Dream.target request in + let user_agent = Dream.header request "User-Agent" |> Option.value ~default:"unknown" in + let client_ip = Dream.client request in + let%lwt () = + Lwt_io.printf "%s %s %s - %s - %s\n" (Ptime_clock.now () |> Ptime.to_rfc3339) method_str path client_ip user_agent + in + let%lwt response = inner_handler request in + let status = Dream.status response |> Dream.status_to_int in + let%lwt () = Lwt_io.printf " -> %d\n" status in + Lwt.return response diff --git a/bs5/server/middleware/promise.ml b/bs5/server/middleware/promise.ml new file mode 100644 index 0000000..cbb81ec --- /dev/null +++ b/bs5/server/middleware/promise.ml @@ -0,0 +1,12 @@ +let successful = ref 0 +let failed = ref 0 + +let count_requests inner_handler request = + try%lwt + let%lwt response = inner_handler request in + successful := !successful +1; + Lwt.return response + + with exn -> + failed := !failed + 1; + raise exn |