send invitation to users

pool/test/filter_assignment_tests.ml

@@ -84,11 +84,9 @@ let experiment () =
 
 let contact ~prefix () =
   let open Contact in
-  let invited_contact_id = Id.create () in
+  let user_id = Id.create () in
   let* email =
-    let email =
-      Format.asprintf "%s+%s@domain.test" prefix (Id.value invited_contact_id)
-    in
+    let email = Format.asprintf "%s+%s@domain.test" prefix (Id.value user_id) in
     Pool_user.EmailAddress.create email
   in
   let* password = Pool_user.Password.create_unvalidated "a-password" in
@@ -100,7 +98,7 @@ let contact ~prefix () =
   let language = Pool_common.Language.En |> Option.some in
   let contact_created =
     [ Contact.created
-        { user_id = invited_contact_id
+        { user_id
         ; email
         ; password
         ; firstname
@@ -112,13 +110,12 @@ let contact ~prefix () =
     ]
   in
   let& () = Pool_event.handle_events test_db contact_created |> Lwt_result.ok in
-  let& contact = Contact.find test_db invited_contact_id in
+  let& contact = Contact.find test_db user_id in
   let%lwt token = Email.create_token test_db email in
   let* verification_events =
     let open Cqrs_command.User_command in
     let created_email =
-      Email.Created (email, token, invited_contact_id)
-      |> Pool_event.email_verification
+      Email.Created (email, token, user_id) |> Pool_event.email_verification
     in
     let email = Email.create email contact.user token in
     let@ verify_events = VerifyEmail.handle (Contact contact) email in
@@ -127,14 +124,14 @@ let contact ~prefix () =
   let& () =
     Pool_event.handle_events test_db verification_events |> Lwt_result.ok
   in
-  let& contact = Contact.find test_db invited_contact_id in
+  let& contact = Contact.find test_db user_id in
   let verification_events =
     [ Contact.Verified contact |> Pool_event.contact ]
   in
   let& () =
     Pool_event.handle_events test_db verification_events |> Lwt_result.ok
   in
-  let& contact = Contact.find test_db invited_contact_id in
+  let& contact = Contact.find test_db user_id in
   Lwt_result.lift (Ok contact)
 ;;
 
@@ -157,15 +154,38 @@ let assignment ~experiment ~session ~contact =
   Lwt_result.lift (Ok ())
 ;;
 
-(** This test verifies that given a contact that was invited to an experiment,
-    and one that was not, the contact that was not invited will show after the
+let invitation ~experiment ~contacts =
+  let open Cqrs_command.Invitation_command in
+  let* events =
+    Create.(
+      handle
+        { experiment
+        ; contacts
+        ; invited_contacts = []
+        ; create_message =
+            (fun _ ->
+              Sihl_email.create
+                ~sender:"sender"
+                ~recipient:"recipient"
+                ~subject:"subject"
+                "body"
+              |> Result.ok)
+        ; mailing = None
+        })
+  in
+  let& () = Pool_event.handle_events test_db events |> Lwt_result.ok in
+  Lwt_result.lift (Ok ())
+;;
+
+(** This test verifies that given a contact that has accpeted an invitation to an experiment,
+    and one that was not, the contact that did not accept will show after the
     assignment exclusion filter is applied.
 
     It does so by:
 
     1. creating an experiment
-    2. creating a contact that is invited to the experiment
-    3. creating a contact that is NOT invited to the experiment
+    2. creating a contact that has accepted an invitation to the experiment
+    3. creating a contact that has NOT accepted an invitation to the experiment
     4. create a filter that for assignments that includes our experiment
     5. assert on the found contacts
 
@@ -177,20 +197,26 @@ let finds_unassigned_contacts =
   let& experiment = experiment () in
   (* 2. creating an session *)
   let& session = session ~experiment in
-  (* 2. creating a contact that is invited to the experiment *)
-  let& invited_contact = contact ~prefix:"invited" () in
-  let& _assignment = assignment ~experiment ~contact:invited_contact ~session in
-  (* 3. creating a contact that is NOT invited to the experiment *)
-  let& expected_contact = contact ~prefix:"probe" () in
-  (* 4. create a filter that for assignments that includes our experiment *)
+  (* 2. creating contacts *)
+  let& assigned_contact = contact ~prefix:"invited" () in
+  let& unassigned_contact = contact ~prefix:"probe" () in
+  (* 3. send invitations *)
+  let& _invitation =
+    invitation ~experiment ~contacts:[ assigned_contact; unassigned_contact ]
+  in
+  (* 4. only accept one of the invitations, creating the assignment *)
+  let& _assignment =
+    assignment ~experiment ~contact:assigned_contact ~session
+  in
+  (* 5. create a filter that for assignments that includes our experiment *)
   let assignment_filter =
     let open Filter in
     let key : Key.t = Key.(Hardcoded Assignment) in
     let value =
       let exp_ids =
         [ Experiment.(experiment.id) ]
-        |> List.map Experiment.Id.value
-        |> List.map (fun value -> Filter.Str value)
+        |> CCList.map Experiment.Id.value
+        |> CCList.map (fun value -> Filter.Str value)
       in
       Lst exp_ids
     in
@@ -210,18 +236,25 @@ let finds_unassigned_contacts =
      have created. This is a HACK and we shoudl fix it by ensuring every test is
      run in its own transaction. *)
   let found_contacts =
-    List.filter
+    CCList.filter
       (fun contact ->
         let open Contact in
         let open Sihl_user in
-        contact.user.id = invited_contact.user.id
-        || contact.user.id = expected_contact.user.id)
+        contact.user.id = unassigned_contact.user.id
+        || contact.user.id = assigned_contact.user.id)
       found_contacts
   in
-  (* 5. assert on the found contacts *)
+  (* 6. assert on the found contacts *)
+  let& expected_contact =
+    Contact.find test_db (Contact.id unassigned_contact)
+  in
   Alcotest.(
-    check int "wrong number of contacts returned" 1 (List.length found_contacts));
-  let actual_contact = List.hd found_contacts in
+    check
+      int
+      "wrong number of contacts returned"
+      1
+      (CCList.length found_contacts));
+  let actual_contact = CCList.hd found_contacts in
   Alcotest.(
     check
       Test_utils.contact
@@ -259,8 +292,8 @@ let filters_out_assigned_contacts =
     let value =
       let exp_ids =
         [ Experiment.(experiment.id) ]
-        |> List.map Experiment.Id.value
-        |> List.map (fun value -> Filter.Str value)
+        |> CCList.map Experiment.Id.value
+        |> CCList.map (fun value -> Filter.Str value)
       in
       Lst exp_ids
     in
@@ -280,7 +313,7 @@ let filters_out_assigned_contacts =
      have created. This is a HACK and we shoudl fix it by ensuring every test is
      run in its own transaction. *)
   let found_contacts =
-    List.filter
+    CCList.filter
       (fun contact ->
         let open Contact in
         let open Sihl_user in
@@ -289,6 +322,10 @@ let filters_out_assigned_contacts =
   in
   (* 4. assert on the found contacts *)
   Alcotest.(
-    check int "wrong number of contacts returned" 0 (List.length found_contacts));
+    check
+      int
+      "wrong number of contacts returned"
+      0
+      (CCList.length found_contacts));
   Lwt_result.lift (Ok ())
 ;;