test: add integration tests for smtp auth

pool/app/email/email.mli

@@ -151,6 +151,8 @@ module SmtpAuth : sig
     ; default : Default.t
     }
 
+  type smtp = t
+
   type update_password =
     { id : Id.t
     ; password : Password.t option
@@ -172,6 +174,8 @@ module SmtpAuth : sig
       ; default : Default.t
       }
 
+    val to_entity : t -> smtp
+
     val create
       :  ?id:Id.t
       -> Label.t

pool/app/email/entity_smtp.ml

@@ -93,6 +93,8 @@ type t =
   }
 [@@deriving eq, show, sexp_of]
 
+type smtp = t
+
 type update_password =
   { id : Id.t
   ; password : Password.t option [@opaque]
@@ -126,4 +128,16 @@ module Write = struct
       ; default
       }
   ;;
+
+  let to_entity (t : t) : smtp =
+    { id = t.id
+    ; label = t.label
+    ; server = t.server
+    ; port = t.port
+    ; username = t.username
+    ; mechanism = t.mechanism
+    ; protocol = t.protocol
+    ; default = t.default
+    }
+  ;;
 end

pool/test/integration.ml

@@ -30,6 +30,8 @@ let suite =
               `Slow
               update_terms_and_conditions
           ; test_case "login after terms update" `Slow login_after_terms_update
+          ; test_case "can create smtp auth" `Slow create_smtp_auth
+          ; test_case "can delete smtp auth" `Slow delete_smtp_auth
           ] )
     ; ( "dev/test"
       , [ test_case "intercept email" `Slow Common_test.validate_email ] )

pool/test/tenant_settings_test.ml

@@ -297,3 +297,98 @@ let login_after_terms_update _ () =
       expected
       accepted)
 ;;
+
+(* Test the creation of an SMTP Authentication record. *)
+let create_smtp_auth =
+  Test_utils.case
+  @@ fun () ->
+  let ( let* ) x f = Lwt_result.bind (Lwt_result.lift x) f in
+  let ( let& ) = Lwt_result.bind in
+  let test_db = Test_utils.Data.database_label in
+  let open Email.SmtpAuth in
+  (* create an smtp auth instance *)
+  let id = Id.create () in
+  let* label = Label.create ("a-label-" ^ Id.show id) in
+  let* server = Server.create "a-server" in
+  let* port = Port.create 2112 in
+  let* username = Username.create "a-username" in
+  let* password = Password.create "Password1!" in
+  let mechanism = Mechanism.PLAIN in
+  let protocol = Protocol.SSL_TLS in
+  let default = Default.create false in
+  let* write_event =
+    Email.SmtpAuth.Write.create
+      ~id
+      label
+      server
+      port
+      (Some username)
+      (Some password)
+      mechanism
+      protocol
+      default
+  in
+  (* feed the event into the event handler to affect the database *)
+  let& () =
+    [ Email.SmtpCreated write_event |> Pool_event.email ]
+    |> Pool_event.handle_events test_db
+    |> Lwt_result.ok
+  in
+  (* get the smtp auth that was actually saved and compare it *)
+  let expected = Email.SmtpAuth.Write.to_entity write_event in
+  let& actual = Email.SmtpAuth.find test_db id in
+  Alcotest.(
+    check Test_utils.smtp_auth "smtp\n   saved correctly" expected actual);
+  Lwt_result.lift (Ok ())
+;;
+
+(* Test the deletion of an SMTP Authentication record. *)
+let delete_smtp_auth =
+  Test_utils.case
+  @@ fun () ->
+  let ( let* ) x f = Lwt_result.bind (Lwt_result.lift x) f in
+  let ( let& ) = Lwt_result.bind in
+  let ( let^ ) = Lwt.bind in
+  let test_db = Test_utils.Data.database_label in
+  let open Email.SmtpAuth in
+  (* create an smtp auth instance *)
+  let id = Id.create () in
+  let* label = Label.create ("a-label-" ^ Id.show id) in
+  let* server = Server.create "a-server" in
+  let* port = Port.create 2112 in
+  let* username = Username.create "a-username" in
+  let* password = Password.create "Password1!" in
+  let mechanism = Mechanism.PLAIN in
+  let protocol = Protocol.SSL_TLS in
+  let default = Default.create false in
+  let* write_event =
+    Email.SmtpAuth.Write.create
+      ~id
+      label
+      server
+      port
+      (Some username)
+      (Some password)
+      mechanism
+      protocol
+      default
+  in
+  (* feed the event into the event handler to affect the database *)
+  let& () =
+    [ Email.SmtpCreated write_event |> Pool_event.email
+    ; Email.SmtpDeleted id |> Pool_event.email
+    ]
+    |> Pool_event.handle_events test_db
+    |> Lwt_result.ok
+  in
+  (* get the smtp auth that was actually saved and compare it *)
+  let^ result = Email.SmtpAuth.find test_db id in
+  let error = Result.get_error result in
+  Alcotest.(
+    check
+      Test_utils.error
+      "the auth record was not deleted"
+      error
+      (Pool_common.Message.NotFound Field.Smtp));
+  Lwt_result.lift (Ok ())
+;;

pool/test/test_utils.ml

@@ -30,6 +30,7 @@ let error =
 ;;
 
 let contact = Alcotest.testable Contact.pp Contact.equal
+let smtp_auth = Alcotest.testable Email.SmtpAuth.pp Email.SmtpAuth.equal
 
 let check_result ?(msg = "succeeds") =
   let open Alcotest in
@@ -546,3 +547,11 @@ module Repo = struct
     Pool_location.find_all Data.database_label ||> CCList.hd
   ;;
 end
+
+(* NOTE(@leostera): here be dragons. This machinery gets rid of any resulting
+   value we have. It will fail a test if the underlying promise returns an
+   Error. *)
+let case fn (_switch : Lwt_switch.t) () : unit Lwt.t =
+  let result = Lwt_result.get_exn @@ Lwt_result.catch fn in
+  Lwt.map (fun _ -> ()) result
+;;