log ip on successfull user registration

pool/web/handler/contact_signup.ml

@@ -57,6 +57,14 @@ let sign_up_create req =
          ||> CCOption.to_result ContactSignupInvalidEmail
          >== Pool_user.EmailAddress.create
        in
+       let log_request () =
+         Logging_helper.log_request_with_ip
+           ~src
+           "User registration"
+           req
+           tags
+           email_address
+       in
        let create_contact_events () =
          let open Command.SignUp in
          let* ({ firstname; lastname; _ } as decoded) =
@@ -92,39 +100,48 @@ let sign_up_create req =
        in
        let* events =
          match existing_user with
-         | None -> create_contact_events ()
+         | None ->
+           let* events = create_contact_events () in
+           log_request ();
+           Lwt_result.return events
          | Some user when Service.User.is_admin user -> Lwt_result.return []
          | Some _ ->
            let%lwt contact =
              email_address |> Contact.find_by_email database_label
            in
-           contact
-           |> (function
-            | Ok contact when contact.Contact.user.Sihl_user.confirmed ->
-              let%lwt send_notification =
-                Contact.should_send_registration_attempt_notification
-                  database_label
-                  contact
-              in
-              if not send_notification
-              then Lwt_result.return []
-              else
-                contact
-                |> Message_template.ContactRegistrationAttempt.create
-                     database_label
-                     (CCOption.value ~default:language contact.Contact.language)
-                     tenant
-                ||> Command.SendRegistrationAttemptNotifitacion.handle
-                      ~tags
-                      contact
-            | Ok contact ->
-              let* create_contact_events = create_contact_events () in
-              let open CCResult.Infix in
-              contact
-              |> Command.DeleteUnverified.handle ~tags
-              >|= CCFun.flip CCList.append create_contact_events
-              |> Lwt_result.lift
-            | Error _ -> Lwt_result.return [])
+           let* events =
+             contact
+             |> function
+             | Ok contact when contact.Contact.user.Sihl_user.confirmed ->
+               let%lwt send_notification =
+                 Contact.should_send_registration_attempt_notification
+                   database_label
+                   contact
+               in
+               if not send_notification
+               then Lwt_result.return []
+               else
+                 contact
+                 |> Message_template.ContactRegistrationAttempt.create
+                      database_label
+                      (CCOption.value
+                         ~default:language
+                         contact.Contact.language)
+                      tenant
+                 ||> Command.SendRegistrationAttemptNotifitacion.handle
+                       ~tags
+                       contact
+             | Ok contact ->
+               let* create_contact_events = create_contact_events () in
+               let open CCResult.Infix in
+               contact
+               |> Command.DeleteUnverified.handle ~tags
+               >|= CCFun.flip CCList.append create_contact_events
+               |> Lwt_result.lift
+             | Error _ -> Lwt_result.return []
+           in
+           log_request ();
+           Lwt_result.return events
        in
        let%lwt () = Pool_event.handle_events ~tags database_label events in
        HttpUtils.(

pool/web/handler/helpers_login.ml

@@ -86,16 +86,7 @@ let login_params urlencoded =
   Lwt_result.return (email, password)
 ;;
 
-let log_request req tags email =
-  let open Opium in
-  let open Request in
-  let ip =
-    Headers.get req.headers "X-Real-IP"
-    |> CCOption.value ~default:"X-Real-IP not found"
-  in
-  Logs.warn ~src (fun m ->
-    m "Failed login attempt: %s %s" ip (EmailAddress.value email) ~tags)
-;;
+let log_request = Logging_helper.log_request_with_ip ~src "Failed login attempt"
 
 let login req urlencoded database_label =
   let open Utils.Lwt_result.Infix in

pool/web/handler/logging_helper.ml

@@ -0,0 +1,10 @@
+let log_request_with_ip ~src message req tags email =
+  let open Opium in
+  let open Request in
+  let ip =
+    Headers.get req.headers "X-Real-IP"
+    |> CCOption.value ~default:"X-Real-IP not found"
+  in
+  Logs.warn ~src (fun m ->
+    m "%s: %s %s" message ip (Pool_user.EmailAddress.value email) ~tags)
+;;