From 9878956716b04c7ae88989cb9b059d3edcb923dc Mon Sep 17 00:00:00 2001
From: Steffen Jost <s.jost@fraport.de>
Date: Tue, 5 Dec 2023 12:12:51 +0100
Subject: [PATCH] fix(firm): set supervisor field not all fields required

---
 src/Handler/Firm.hs | 22 +++++++++++-----------
 src/Utils.hs        |  1 +
 2 files changed, 12 insertions(+), 11 deletions(-)

diff --git a/src/Handler/Firm.hs b/src/Handler/Firm.hs
index 194eea1dc..c6d77abc1 100644
--- a/src/Handler/Firm.hs
+++ b/src/Handler/Firm.hs
@@ -520,15 +520,15 @@ mkFirmAllTable isAdmin uid = do
           , single ("is-supervisor" , FilterColumn . E.mkExistsFilter $ \row (criterion :: Text) -> do
               (usr :& usrCmp) <- E.from $ E.table @User
                 `E.leftJoin` E.table @UserCompany
-                `E.on` (\(usr :& usrCmp) -> usr E.^. UserId E.==. usrCmp E.^. UserCompanyUser)
+                `E.on` (\(usr :& usrCmp) -> usr E.^. UserId E.=?. usrCmp E.?. UserCompanyUser)
               E.where_ $ ((usr E.^. UserDisplayName  `E.hasInfix` E.val criterion)
                     E.||. (usr E.^. UserDisplayEmail `E.hasInfix` E.val (CI.mk criterion))
                     E.||. (usr E.^. UserSurname      `E.hasInfix` E.val criterion)
-                ) E.&&. ((E.isTrue (usrCmp E.?. UserCompanySupervisor) E.&&. usrCmp E.? . UserCompanyCompany E.?=. queryAllCompany row E.^. CompanyId)
+                ) E.&&. ((E.isTrue (usrCmp E.?. UserCompanySupervisor) E.&&. usrCmp E.?. UserCompanyCompany E.?=. queryAllCompany row E.^. CompanyId)
                     E.||. E.exists (do
                         usrSpr <- E.from $ E.table @UserSupervisor
                         E.where_ $ usrSpr E.^. UserSupervisorSupervisor E.==. usr E.^. UserId
-                          E.&& E.exists (do
+                          E.&&. E.exists (do
                               usrSub <- E.from $ E.table @UserCompany
                               E.where_ $ usrSub E.^. UserCompanyUser    E.==. usrSpr E.^. UserSupervisorUser
                                   E.&&.  usrSub E.^. UserCompanyCompany E.==. queryAllCompany row E.^. CompanyId
@@ -638,8 +638,8 @@ data FirmUserActionData = FirmUserActNotifyData
                             -- , firmUserActResetMutualSupervision :: Maybe Bool
                             }
                         | FirmUserActSetSupervisorData
-                            {  firmUserActSetSuperNames   :: Set Text
-                            ,  firmUserActSetSuperIds     :: [UserId]
+                            {  firmUserActSetSuperNames   :: Maybe (Set Text)
+                            ,  firmUserActSetSuperIds     :: Maybe [UserId]
                             ,  firmUserActSetSuperReroute :: Bool
                             ,  firmUserActSetSuperKeep    :: Bool
                             }
@@ -798,10 +798,10 @@ mkFirmUserTable isAdmin cid = do
               <$> aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFirmActResetSuperKeep)         (Just $ Just False)
               -- <*> aopt checkBoxField                                      (fslI MsgFirmActResetMutualSupervision) (Just $ Just True )
           , singletonMap FirmUserActSetSupervisor $ FirmUserActSetSupervisorData
-              <$> apopt (textField & cfAnySeparatedSet) (fslI MsgFirmNewSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing
-              <*> apopt supervisorsField (fslI MsgFirmSetSupervisor) Nothing
-              <*> apopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgMailSupervisorReroute & setTooltip MsgMailSupervisorRerouteTooltip) (Just False)
-              <*> areq  (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFirmActResetSuperKeep) (Just False)
+              <$> aopt (textField & cfAnySeparatedSet) (fslI MsgFirmNewSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing
+              <*> aopt supervisorsField (fslI MsgFirmSetSupervisor) Nothing
+              <*> areq (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgMailSupervisorReroute & setTooltip MsgMailSupervisorRerouteTooltip) (Just False)
+              <*> areq (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFirmActResetSuperKeep) (Just False)
           , singletonMap FirmUserActMkSuper $ FirmUserActMkSuperData
               <$> aopt checkBoxField (fslI MsgTableIsDefaultReroute) (Just $ Just True)
           , singletonMap FirmUserActChangeContact $ FirmUserActChangeContactData
@@ -887,10 +887,10 @@ postFirmUsersR fsh = do
         addMessageI Info $ MsgFirmResetSupervision delSupers newSupers
       reloadKeepGetParams $ FirmUsersR fsh -- reload to reflect changes
     (FirmUserActSetSupervisorData{..}, set2NonEmpty (error "Unexpected empty user list in getFirmUserR action handler.") -> uids) -> do
-      avsUsers :: Map Text (Maybe UserId) <- sequenceA $ Map.fromSet guessAvsUser firmUserActSetSuperNames
+      avsUsers :: Map Text (Maybe UserId) <- sequenceA $ Map.fromSet guessAvsUser $ maybeMonoid firmUserActSetSuperNames
       let (usersFound', usersNotFound) = partition (is _Just . view _2) $ Map.toList avsUsers
           usersFound = mapMaybe snd usersFound'
-          newSupers = Set.toList $ Set.fromList firmUserActSetSuperIds <> Set.fromList usersFound
+          newSupers = Set.toList $ Set.fromList (maybeMonoid firmUserActSetSuperIds) <> Set.fromList usersFound
           nrSupers = fromIntegral $ length newSupers
           nrUsers  = fromIntegral $ length uids
       unless (null usersNotFound) $
diff --git a/src/Utils.hs b/src/Utils.hs
index a2b35c37a..2093da8b2 100644
--- a/src/Utils.hs
+++ b/src/Utils.hs
@@ -626,6 +626,7 @@ guardMonoid True  x = x
 assertMonoid :: Monoid m => (m -> Bool) -> m -> m
 assertMonoid f x = guardMonoid (f x) x
 
+-- fold would also do, but is more risky if the Folable isn't Maybe
 maybeMonoid :: Monoid m => Maybe m -> m
 -- ^ Identify `Nothing` with `mempty`
 maybeMonoid = fromMaybe mempty