Feature/320 external data

CHANGELOG.md

@@ -4,10 +4,17 @@ The format is based on [Keep a Changelog](http://keepachangelog.com/) and this p
 
 ## [unreleased](https://github.com/uzh/pool/tree/HEAD)
 
+### Added
+
+- external_data_required to experiments
+- external_data_id to assignments (required latest on session close)
+
 ### Changed
 
 - include contacts whose import is pending in filter
 - allow password reset when import is pending
+- hide contact information when not allowed to read it
+- split first-/lastname of contact information list in session assignments
 
 ## [0.4.0](https://github.com/uzh/pool/tree/0.4.0) - 2023-08-03
 

pool/app/assignment/assignment.mli

@@ -32,6 +32,10 @@ module MarkedAsDeleted : sig
   val init : t
 end
 
+module ExternalDataId : sig
+  include Pool_common.Model.StringSig
+end
+
 type t =
   { id : Id.t
   ; contact : Contact.t
@@ -40,6 +44,7 @@ type t =
   ; matches_filter : MatchesFilter.t
   ; canceled_at : CanceledAt.t option
   ; marked_as_deleted : MarkedAsDeleted.t
+  ; external_data_id : ExternalDataId.t option
   ; created_at : Pool_common.CreatedAt.t
   ; updated_at : Pool_common.UpdatedAt.t
   }
@@ -55,6 +60,7 @@ val create
   -> ?matches_filter:MatchesFilter.t
   -> ?canceled_at:CanceledAt.t
   -> ?marked_as_deleted:MarkedAsDeleted.t
+  -> ?external_data_id:ExternalDataId.t
   -> Contact.t
   -> t
 
@@ -141,6 +147,7 @@ type event =
   | Canceled of t
   | Created of create
   | MarkedAsDeleted of t
+  | ExternalDataIdUpdated of t * ExternalDataId.t option
 
 val attendanceset : t * NoShow.t * Participated.t -> event
 val canceled : t -> event

pool/app/assignment/entity.ml

@@ -40,6 +40,13 @@ module MarkedAsDeleted = struct
   let schema = schema Pool_common.Message.Field.MarkedAsDeleted
 end
 
+module ExternalDataId = struct
+  include Pool_common.Model.String
+
+  let field = Pool_common.Message.Field.ExternalDataId
+  let schema () = schema field ()
+end
+
 type t =
   { id : Id.t
   ; contact : Contact.t
@@ -48,6 +55,7 @@ type t =
   ; matches_filter : MatchesFilter.t
   ; canceled_at : CanceledAt.t option
   ; marked_as_deleted : MarkedAsDeleted.t
+  ; external_data_id : ExternalDataId.t option
   ; created_at : Pool_common.CreatedAt.t
   ; updated_at : Pool_common.UpdatedAt.t
   }
@@ -60,6 +68,7 @@ let create
   ?(matches_filter = MatchesFilter.create true)
   ?canceled_at
   ?(marked_as_deleted = MarkedAsDeleted.init)
+  ?external_data_id
   contact
   =
   { id
@@ -69,6 +78,7 @@ let create
   ; matches_filter
   ; canceled_at
   ; marked_as_deleted
+  ; external_data_id
   ; created_at = Pool_common.CreatedAt.create ()
   ; updated_at = Pool_common.UpdatedAt.create ()
   }

pool/app/assignment/event.ml

@@ -11,6 +11,7 @@ type event =
   | Canceled of t
   | Created of create
   | MarkedAsDeleted of t
+  | ExternalDataIdUpdated of t * ExternalDataId.t option
 [@@deriving eq, show, variants]
 
 let handle_event pool : event -> unit Lwt.t = function
@@ -35,4 +36,6 @@ let handle_event pool : event -> unit Lwt.t = function
     ||> Pool_common.Utils.get_or_failwith
     ||> fun (_ : [> `Assignment ] Guard.Target.t) -> ()
   | MarkedAsDeleted assignment -> assignment.id |> Repo.marked_as_deleted pool
+  | ExternalDataIdUpdated (assignment, external_data_id) ->
+    { assignment with external_data_id } |> Repo.update pool
 ;;

pool/app/assignment/repo/repo.ml

@@ -35,6 +35,7 @@ module Sql = struct
           pool_assignments.matches_filter,
           pool_assignments.canceled_at,
           pool_assignments.marked_as_deleted,
+          pool_assignments.external_data_id,
           pool_assignments.created_at,
           pool_assignments.updated_at
         FROM
@@ -285,6 +286,7 @@ module Sql = struct
         participated,
         matches_filter,
         canceled_at,
+        external_data_id,
         created_at,
         updated_at
       ) VALUES (
@@ -296,7 +298,8 @@ module Sql = struct
         $6,
         $7,
         $9,
-        $10
+        $10,
+        $11
       )
       ON DUPLICATE KEY UPDATE
         marked_as_deleted = 0
@@ -317,14 +320,19 @@ module Sql = struct
           no_show = $2,
           participated = $3,
           matches_filter = $4,
-          canceled_at = $5
+          canceled_at = $5,
+          external_data_id = $6
         WHERE
           uuid = UNHEX(REPLACE($1, '-', ''))
       |sql}
     |> Caqti_type.(
          tup2
            string
-           (tup2 (option bool) (tup2 (option bool) (tup2 bool (option ptime))))
+           (tup2
+              (option bool)
+              (tup2
+                 (option bool)
+                 (tup2 bool (tup2 (option ptime) (option string)))))
          ->. unit)
   ;;
 
@@ -334,7 +342,8 @@ module Sql = struct
       , ( m.no_show
         , ( m.participated
           , ( m.matches_filter |> MatchesFilter.value
-            , CCOption.map CanceledAt.value m.canceled_at ) ) ) ))
+            , (CCOption.map CanceledAt.value m.canceled_at, m.external_data_id)
+            ) ) ) ))
   ;;
 
   let update pool m =

pool/app/assignment/repo/repo_entity.ml

@@ -28,6 +28,12 @@ module MarkedAsDeleted = struct
   let t = Caqti_type.bool
 end
 
+module ExternalDataId = struct
+  include Entity.ExternalDataId
+
+  let t = Pool_common.Repo.make_caqti_type Caqti_type.string create value
+end
+
 type t =
   { id : Pool_common.Id.t
   ; session_id : Session.Id.t
@@ -37,6 +43,7 @@ type t =
   ; matches_filter : MatchesFilter.t
   ; canceled_at : CanceledAt.t option
   ; marked_as_deleted : MarkedAsDeleted.t
+  ; external_data_id : ExternalDataId.t option
   ; created_at : Pool_common.CreatedAt.t
   ; updated_at : Pool_common.UpdatedAt.t
   }
@@ -50,6 +57,7 @@ let to_entity (m : t) (contact : Contact.t) : Entity.t =
     ; matches_filter = m.matches_filter
     ; canceled_at = m.canceled_at
     ; marked_as_deleted = m.marked_as_deleted
+    ; external_data_id = m.external_data_id
     ; created_at = m.created_at
     ; updated_at = m.updated_at
     }
@@ -64,6 +72,7 @@ let of_entity (session_id : Session.Id.t) (m : Entity.t) : t =
   ; matches_filter = m.Entity.matches_filter
   ; canceled_at = m.Entity.canceled_at
   ; marked_as_deleted = m.Entity.marked_as_deleted
+  ; external_data_id = m.Entity.external_data_id
   ; created_at = m.Entity.created_at
   ; updated_at = m.Entity.updated_at
   }
@@ -79,8 +88,9 @@ let t =
             , ( m.participated
               , ( m.matches_filter
                 , ( m.canceled_at
-                  , (m.marked_as_deleted, (m.created_at, m.updated_at)) ) ) ) )
-          ) ) )
+                  , ( m.marked_as_deleted
+                    , (m.external_data_id, (m.created_at, m.updated_at)) ) ) )
+              ) ) ) ) )
   in
   let decode
     ( id
@@ -89,8 +99,10 @@ let t =
         , ( no_show
           , ( participated
             , ( matches_filter
-              , (canceled_at, (marked_as_deleted, (created_at, updated_at))) )
-            ) ) ) ) )
+              , ( canceled_at
+                , ( marked_as_deleted
+                  , (external_data_id, (created_at, updated_at)) ) ) ) ) ) ) )
+    )
     =
     let open CCResult in
     Ok
@@ -102,6 +114,7 @@ let t =
       ; matches_filter = MatchesFilter.create matches_filter
       ; canceled_at = CCOption.map CanceledAt.value canceled_at
       ; marked_as_deleted
+      ; external_data_id
       ; created_at
       ; updated_at
       }
@@ -127,8 +140,10 @@ let t =
                            (tup2
                               MarkedAsDeleted.t
                               (tup2
-                                 Pool_common.Repo.CreatedAt.t
-                                 Pool_common.Repo.UpdatedAt.t))))))))))
+                                 (option ExternalDataId.t)
+                                 (tup2
+                                    Pool_common.Repo.CreatedAt.t
+                                    Pool_common.Repo.UpdatedAt.t)))))))))))
 ;;
 
 module Public = struct

pool/app/contact/contact.mli

@@ -289,5 +289,8 @@ module Guard : sig
     val create : Guard.ValidationSet.t
     val read : Id.t -> Guard.ValidationSet.t
     val update : Id.t -> Guard.ValidationSet.t
+    val read_name : Guard.ValidationSet.t
+    val read_email : Guard.ValidationSet.t
+    val read_cellphone : Guard.ValidationSet.t
   end
 end

pool/app/contact/entity_guard.ml

@@ -49,4 +49,7 @@ module Access = struct
   let create = One (Action.Create, TargetSpec.Entity `Contact)
   let read = contact Action.Read
   let update = contact Action.Update
+  let read_name = Or [ index; SpecificRole `ReadContactName ]
+  let read_email = Or [ index; SpecificRole `ReadContactEmail ]
+  let read_cellphone = Or [ index; SpecificRole `ReadContactCellphone ]
 end

pool/app/experiment/entity.ml

@@ -52,6 +52,12 @@ module AllowUninvitedSignup = struct
   let schema = schema Common.Message.Field.AllowUninvitedSignup
 end
 
+module ExternalDataRequired = struct
+  include Pool_common.Model.Boolean
+
+  let schema = schema Common.Message.Field.ExternalDataRequired
+end
+
 type t =
   { id : Id.t
   ; title : Title.t
@@ -65,6 +71,7 @@ type t =
   ; direct_registration_disabled : DirectRegistrationDisabled.t
   ; registration_disabled : RegistrationDisabled.t
   ; allow_uninvited_signup : AllowUninvitedSignup.t
+  ; external_data_required : ExternalDataRequired.t
   ; experiment_type : Pool_common.ExperimentType.t option
   ; session_reminder_lead_time : Pool_common.Reminder.LeadTime.t option
   ; created_at : Ptime.t
@@ -84,6 +91,7 @@ let create
   direct_registration_disabled
   registration_disabled
   allow_uninvited_signup
+  external_data_required
   experiment_type
   session_reminder_lead_time
   =
@@ -101,6 +109,7 @@ let create
     ; direct_registration_disabled
     ; registration_disabled
     ; allow_uninvited_signup
+    ; external_data_required
     ; experiment_type
     ; session_reminder_lead_time
     ; created_at = Ptime_clock.now ()
@@ -157,9 +166,17 @@ let allow_uninvited_signup_value (m : t) =
   AllowUninvitedSignup.value m.allow_uninvited_signup
 ;;
 
+let external_data_required_value (m : t) =
+  ExternalDataRequired.value m.external_data_required
+;;
+
 let boolean_fields =
   Pool_common.Message.Field.
-    [ DirectRegistrationDisabled; RegistrationDisabled; AllowUninvitedSignup ]
+    [ DirectRegistrationDisabled
+    ; RegistrationDisabled
+    ; AllowUninvitedSignup
+    ; ExternalDataRequired
+    ]
 ;;
 
 let searchable_by =

pool/app/experiment/event.ml

@@ -8,6 +8,7 @@ type create =
   ; direct_registration_disabled : DirectRegistrationDisabled.t
   ; registration_disabled : RegistrationDisabled.t
   ; allow_uninvited_signup : AllowUninvitedSignup.t
+  ; external_data_required : ExternalDataRequired.t
   ; experiment_type : Pool_common.ExperimentType.t option
   ; session_reminder_lead_time : Pool_common.Reminder.LeadTime.t option
   }

pool/app/experiment/experiment.mli

@@ -42,6 +42,10 @@ module AllowUninvitedSignup : sig
     -> (Pool_common.Message.error, t) Pool_common.Utils.PoolConformist.Field.t
 end
 
+module ExternalDataRequired : sig
+  include Pool_common.Model.BooleanSig
+end
+
 type t =
   { id : Id.t
   ; title : Title.t
@@ -55,6 +59,7 @@ type t =
   ; direct_registration_disabled : DirectRegistrationDisabled.t
   ; registration_disabled : RegistrationDisabled.t
   ; allow_uninvited_signup : AllowUninvitedSignup.t
+  ; external_data_required : ExternalDataRequired.t
   ; experiment_type : Pool_common.ExperimentType.t option
   ; session_reminder_lead_time : Pool_common.Reminder.LeadTime.t option
   ; created_at : Ptime.t
@@ -77,6 +82,7 @@ val create
   -> DirectRegistrationDisabled.t
   -> RegistrationDisabled.t
   -> AllowUninvitedSignup.t
+  -> ExternalDataRequired.t
   -> Pool_common.ExperimentType.t option
   -> Pool_common.Reminder.LeadTime.t option
   -> (t, Pool_common.Message.error) result
@@ -89,6 +95,7 @@ type create =
   ; direct_registration_disabled : DirectRegistrationDisabled.t
   ; registration_disabled : RegistrationDisabled.t
   ; allow_uninvited_signup : AllowUninvitedSignup.t
+  ; external_data_required : ExternalDataRequired.t
   ; experiment_type : Pool_common.ExperimentType.t option
   ; session_reminder_lead_time : Pool_common.Reminder.LeadTime.t option
   }
@@ -200,6 +207,7 @@ val session_reminder_lead_time_value : t -> Ptime.span option
 val direct_registration_disabled_value : t -> bool
 val registration_disabled_value : t -> bool
 val allow_uninvited_signup_value : t -> bool
+val external_data_required_value : t -> bool
 
 val smtp_auth
   :  Pool_database.Label.t