From dd7ea95b41bf60f470a799bfbbfeb192bdcc2b16 Mon Sep 17 00:00:00 2001 From: Leandro Ostera Date: Fri, 17 Nov 2023 03:24:26 +0100 Subject: [PATCH] test: add integration tests for smtp auth --- pool/app/email/email.mli | 4 ++ pool/app/email/entity_smtp.ml | 14 +++++ pool/test/integration.ml | 2 + pool/test/tenant_settings_test.ml | 95 +++++++++++++++++++++++++++++++ pool/test/test_utils.ml | 9 +++ 5 files changed, 124 insertions(+) diff --git a/pool/app/email/email.mli b/pool/app/email/email.mli index fac15e9ca..57c1cfe71 100644 --- a/pool/app/email/email.mli +++ b/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 diff --git a/pool/app/email/entity_smtp.ml b/pool/app/email/entity_smtp.ml index 4b0cc5d4e..abc8c0e5f 100644 --- a/pool/app/email/entity_smtp.ml +++ b/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 diff --git a/pool/test/integration.ml b/pool/test/integration.ml index 690781464..b503e707a 100644 --- a/pool/test/integration.ml +++ b/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 ] ) diff --git a/pool/test/tenant_settings_test.ml b/pool/test/tenant_settings_test.ml index a08651190..0adaaee26 100644 --- a/pool/test/tenant_settings_test.ml +++ b/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 ()) +;; diff --git a/pool/test/test_utils.ml b/pool/test/test_utils.ml index ec2c3197b..68dce1fed 100644 --- a/pool/test/test_utils.ml +++ b/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 +;;