summaryrefslogtreecommitdiff
path: root/bs5/server/middleware
diff options
context:
space:
mode:
Diffstat (limited to 'bs5/server/middleware')
-rw-r--r--bs5/server/middleware/counter.ml5
-rw-r--r--bs5/server/middleware/dune5
-rw-r--r--bs5/server/middleware/logs.ml12
-rw-r--r--bs5/server/middleware/promise.ml12
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