fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

chore(avs): prepare function to update all letter receivers

Browse Source
This commit is contained in:
Steffen Jost 2022-12-08 17:03:10 +01:00
parent 612fd9284b
commit 1686a96cc5
3 changed files with 103 additions and 79 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

110
src/Handler/Utils/Avs.hs
View File

@ -13,6 +13,7 @@ module Handler.Utils.Avs
, synchAvsLicences , synchAvsLicences
, lookupAvsUser, lookupAvsUsers , lookupAvsUser, lookupAvsUsers
, AvsException(..) , AvsException(..)
, updateReceivers
) where ) where
import Import import Import
@ -69,7 +70,7 @@ instance Exception AvsException
-} -}
{- AVS interface only allows collecting all licences at once, thus getLicence should be avoided, see getLicenceByAvsId including a workaround {- AVS interface only allows collecting all licences at once, thus getLicence should be avoided, see getLicenceByAvsId including a workaround
-- Do we need this? -- Do we need this?
-- getLicence :: UserId -> Handler (Maybe AvsLicence) -- with runDB -- getLicence :: UserId -> Handler (Maybe AvsLicence) -- with runDB
getLicence :: ( MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX, WithRunDB SqlReadBackend (HandlerFor UniWorX) m ) => UserId -> m (Maybe AvsLicence) getLicence :: ( MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX, WithRunDB SqlReadBackend (HandlerFor UniWorX) m ) => UserId -> m (Maybe AvsLicence)
@ -107,7 +108,7 @@ setLicence uid lic = do
Entity _ UserAvs{..} <- maybeThrowM (AvsUserUnassociated uid) $ getBy $ UniqueUserAvsUser uid Entity _ UserAvs{..} <- maybeThrowM (AvsUserUnassociated uid) $ getBy $ UniqueUserAvsUser uid
setLicenceAvs userAvsPersonId lic setLicenceAvs userAvsPersonId lic
setLicenceAvs :: (MonadHandler m, MonadThrow m, HandlerSite m ~ UniWorX) => setLicenceAvs :: (MonadHandler m, MonadThrow m, HandlerSite m ~ UniWorX) =>
AvsPersonId -> AvsLicence -> m Bool AvsPersonId -> AvsLicence -> m Bool
setLicenceAvs apid lic = do setLicenceAvs apid lic = do
let req = Set.singleton $ AvsPersonLicence { avsLicenceRampLicence = lic, avsLicencePersonID = apid } let req = Set.singleton $ AvsPersonLicence { avsLicenceRampLicence = lic, avsLicencePersonID = apid }
@ -119,12 +120,12 @@ setLicencesAvs :: (MonadHandler m, MonadThrow m, HandlerSite m ~ UniWorX) =>
Set AvsPersonLicence -> m Bool Set AvsPersonLicence -> m Bool
setLicencesAvs persLics = do setLicencesAvs persLics = do
AvsQuery{avsQuerySetLicences=aqsl} <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery AvsQuery{avsQuerySetLicences=aqsl} <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery
aux aqsl True persLics aux aqsl True persLics
where where
aux aqsl batch0_ok pls aux aqsl batch0_ok pls
| Set.null pls = return batch0_ok | Set.null pls = return batch0_ok
| otherwise = do | otherwise = do
let (batch1, batch2) = Set.splitAt avsMaxSetLicenceAtOnce pls let (batch1, batch2) = Set.splitAt avsMaxSetLicenceAtOnce pls
response <- throwLeftM $ aqsl $ AvsQuerySetLicences batch1 response <- throwLeftM $ aqsl $ AvsQuerySetLicences batch1
case response of case response of
AvsResponseSetLicencesError{..} -> do AvsResponseSetLicencesError{..} -> do
@ -134,7 +135,7 @@ setLicencesAvs persLics = do
AvsResponseSetLicences msgs -> do AvsResponseSetLicences msgs -> do
let (ok,bad') = Set.partition (sloppyBool . avsResponseSuccess) msgs let (ok,bad') = Set.partition (sloppyBool . avsResponseSuccess) msgs
ok_ids = Set.map avsResponsePersonID ok ok_ids = Set.map avsResponsePersonID ok
bad = Map.withoutKeys (setToMap avsResponsePersonID bad') ok_ids -- it is possible to receive an id multiple times, with only one success, but this is sufficient bad = Map.withoutKeys (setToMap avsResponsePersonID bad') ok_ids -- it is possible to receive an id multiple times, with only one success, but this is sufficient
batch1_ok = length ok == length batch1 batch1_ok = length ok == length batch1
forM_ bad $ \AvsLicenceResponse { avsResponsePersonID=api, avsResponseMessage=msg} -> forM_ bad $ \AvsLicenceResponse { avsResponsePersonID=api, avsResponseMessage=msg} ->
@ -147,7 +148,7 @@ setLicencesAvs persLics = do
-- Only react to changes as compared to last seen status in avs.model -- Only react to changes as compared to last seen status in avs.model
-- TODO: run in a background job, once the interface is actually available -- TODO: run in a background job, once the interface is actually available
synchAvsLicences :: Handler Bool synchAvsLicences :: Handler Bool
synchAvsLicences = do synchAvsLicences = do
AvsQuery{..} <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery AvsQuery{..} <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery
allLicences <- throwLeftM avsQueryGetAllLicences allLicences <- throwLeftM avsQueryGetAllLicences
deltaLicences <- computeDifferingLicences allLicences deltaLicences <- computeDifferingLicences allLicences
@ -161,21 +162,21 @@ computeDifferingLicences :: AvsResponseGetLicences -> Handler (Set AvsPersonLice
computeDifferingLicences argl = do computeDifferingLicences argl = do
(setTo0, setTo1, setTo2) <- getDifferingLicences argl (setTo0, setTo1, setTo2) <- getDifferingLicences argl
return $ Set.map (AvsPersonLicence AvsNoLicence) setTo0 return $ Set.map (AvsPersonLicence AvsNoLicence) setTo0
<> Set.map (AvsPersonLicence AvsLicenceVorfeld) setTo1 <> Set.map (AvsPersonLicence AvsLicenceVorfeld) setTo1
<> Set.map (AvsPersonLicence AvsLicenceRollfeld) setTo2 <> Set.map (AvsPersonLicence AvsLicenceRollfeld) setTo2
retrieveDifferingLicences :: Handler (Set AvsPersonId, Set AvsPersonId, Set AvsPersonId) retrieveDifferingLicences :: Handler (Set AvsPersonId, Set AvsPersonId, Set AvsPersonId)
retrieveDifferingLicences = do retrieveDifferingLicences = do
AvsQuery{..} <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery AvsQuery{..} <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery
allLicences <- throwLeftM avsQueryGetAllLicences allLicences <- throwLeftM avsQueryGetAllLicences
getDifferingLicences allLicences getDifferingLicences allLicences
getDifferingLicences :: AvsResponseGetLicences -> Handler (Set AvsPersonId, Set AvsPersonId, Set AvsPersonId) getDifferingLicences :: AvsResponseGetLicences -> Handler (Set AvsPersonId, Set AvsPersonId, Set AvsPersonId)
getDifferingLicences (AvsResponseGetLicences licences) = do getDifferingLicences (AvsResponseGetLicences licences) = do
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
--let (vorfeld, nonvorfeld) = Set.partition (`avsPersonLicenceIs` AvsLicenceVorfeld) licences --let (vorfeld, nonvorfeld) = Set.partition (`avsPersonLicenceIs` AvsLicenceVorfeld) licences
-- rollfeld = Set.filter (`avsPersonLicenceIs` AvsLicenceRollfeld) nonvorfeld -- rollfeld = Set.filter (`avsPersonLicenceIs` AvsLicenceRollfeld) nonvorfeld
-- Note: FRADrive users with 'R' also own 'F' qualification, but AvsGetResponseGetLicences yields only either -- Note: FRADrive users with 'R' also own 'F' qualification, but AvsGetResponseGetLicences yields only either
let nowaday = utctDay now let nowaday = utctDay now
noOne = AvsPersonId 0 noOne = AvsPersonId 0
vorORrollfeld' = Set.dropWhileAntitone (`avsPersonLicenceIsLEQ` AvsNoLicence) licences vorORrollfeld' = Set.dropWhileAntitone (`avsPersonLicenceIsLEQ` AvsNoLicence) licences
@ -184,18 +185,18 @@ getDifferingLicences (AvsResponseGetLicences licences) = do
rollfeld = Set.map avsLicencePersonID rollfeld' rollfeld = Set.map avsLicencePersonID rollfeld'
antijoinAvsLicences :: AvsLicence -> Set AvsPersonId -> DB (Set AvsPersonId,Set AvsPersonId) antijoinAvsLicences :: AvsLicence -> Set AvsPersonId -> DB (Set AvsPersonId,Set AvsPersonId)
antijoinAvsLicences lic avsLics = fmap unwrapIds $ antijoinAvsLicences lic avsLics = fmap unwrapIds $
E.select $ do E.select $ do
((_qauli :& _qualUser :& usrAvs) :& excl) <- ((_qauli :& _qualUser :& usrAvs) :& excl) <-
E.from $ ( E.table @Qualification E.from $ ( E.table @Qualification
`E.innerJoin` E.table @QualificationUser `E.innerJoin` E.table @QualificationUser
`E.on` ( \(quali :& qualUser) -> `E.on` ( \(quali :& qualUser) ->
(quali E.^. QualificationId E.==. qualUser E.^. QualificationUserQualification) (quali E.^. QualificationId E.==. qualUser E.^. QualificationUserQualification)
-- NOTE: filters on the innerJoin must be part of ON-condition in order for anti-join to work! -- NOTE: filters on the innerJoin must be part of ON-condition in order for anti-join to work!
E.&&. (quali E.^. QualificationAvsLicence E.==. E.justVal lic) -- correct type of licence E.&&. (quali E.^. QualificationAvsLicence E.==. E.justVal lic) -- correct type of licence
E.&&. (E.val nowaday `E.between` (qualUser E.^. QualificationUserFirstHeld E.&&. (E.val nowaday `E.between` (qualUser E.^. QualificationUserFirstHeld
,qualUser E.^. QualificationUserValidUntil)) -- currently valid ,qualUser E.^. QualificationUserValidUntil)) -- currently valid
E.&&. E.isNothing (qualUser E.^. QualificationUserBlockedDue) -- not blocked E.&&. E.isNothing (qualUser E.^. QualificationUserBlockedDue) -- not blocked
) )
`E.innerJoin` E.table @UserAvs `E.innerJoin` E.table @UserAvs
`E.on` (\(_ :& qualUser :& usrAvs) -> qualUser E.^. QualificationUserUser E.==. usrAvs E.^. UserAvsUser) `E.on` (\(_ :& qualUser :& usrAvs) -> qualUser E.^. QualificationUserUser E.==. usrAvs E.^. UserAvsUser)
@ -204,41 +205,41 @@ getDifferingLicences (AvsResponseGetLicences licences) = do
E.where_ $ E.isNothing excl E.||. E.isNothing (usrAvs E.?. UserAvsPersonId) -- anti join E.where_ $ E.isNothing excl E.||. E.isNothing (usrAvs E.?. UserAvsPersonId) -- anti join
return (usrAvs E.?. UserAvsPersonId, excl) return (usrAvs E.?. UserAvsPersonId, excl)
unwrapIds :: [(E.Value (Maybe AvsPersonId), E.Value (Maybe AvsPersonId))] -> (Set AvsPersonId, Set AvsPersonId) unwrapIds :: [(E.Value (Maybe AvsPersonId), E.Value (Maybe AvsPersonId))] -> (Set AvsPersonId, Set AvsPersonId)
unwrapIds = mapBoth (Set.delete noOne) . foldr aux mempty unwrapIds = mapBoth (Set.delete noOne) . foldr aux mempty
where where
aux (_, E.Value(Just api)) (l,r) = (l, Set.insert api r) -- we may assume here that each pair contains precisely one Just constructor aux (_, E.Value(Just api)) (l,r) = (l, Set.insert api r) -- we may assume here that each pair contains precisely one Just constructor
aux (E.Value(Just api), _) (l,r) = (Set.insert api l, r) aux (E.Value(Just api), _) (l,r) = (Set.insert api l, r)
aux _ acc = acc -- should never occur aux _ acc = acc -- should never occur
((vorfGrant, vorfRevoke), (rollGrant, rollRevoke)) <- runDB $ (,) ((vorfGrant, vorfRevoke), (rollGrant, rollRevoke)) <- runDB $ (,)
<$> antijoinAvsLicences AvsLicenceVorfeld vorORrollfeld <$> antijoinAvsLicences AvsLicenceVorfeld vorORrollfeld
<*> antijoinAvsLicences AvsLicenceRollfeld rollfeld <*> antijoinAvsLicences AvsLicenceRollfeld rollfeld
let setTo0 = vorfRevoke -- ready to use with SET 0 let setTo0 = vorfRevoke -- ready to use with SET 0
setTo1 = (vorfGrant Set.\\ rollGrant ) `Set.union` (rollRevoke Set.\\ vorfRevoke) setTo1 = (vorfGrant Set.\\ rollGrant ) `Set.union` (rollRevoke Set.\\ vorfRevoke)
setTo2 = (rollGrant Set.\\ vorfRevoke) `Set.intersection` (vorfGrant `Set.union` vorORrollfeld) setTo2 = (rollGrant Set.\\ vorfRevoke) `Set.intersection` (vorfGrant `Set.union` vorORrollfeld)
return (setTo0, setTo1, setTo2) return (setTo0, setTo1, setTo2)
{- Cases to consider (AVS_Licence,has_valid_F, has_valid_R) -> (vorfeld@(toset,unset), rollfeld@(toset,unset)) : {- Cases to consider (AVS_Licence,has_valid_F, has_valid_R) -> (vorfeld@(toset,unset), rollfeld@(toset,unset)) :
A (0,0,0) -> ((_,_),(_,_)) : nop; avs_id not returned from queries, no problem A (0,0,0) -> ((_,_),(_,_)) : nop; avs_id not returned from queries, no problem
B (0,0,1) -> ((_,_),(x,_)) : nop; do nothing -- CHECK since id is returned by roll-query B (0,0,1) -> ((_,_),(x,_)) : nop; do nothing -- CHECK since id is returned by roll-query
C (0,1,0) -> ((x,_),(_,_)) : set F for id C (0,1,0) -> ((x,_),(_,_)) : set F for id
D (0,1,1) -> ((x,_),(x,_)) : set R for id D (0,1,1) -> ((x,_),(x,_)) : set R for id
E (1,0,0) -> ((_,x),(_,_)) : set 0 for id E (1,0,0) -> ((_,x),(_,_)) : set 0 for id
F (1,0,1) -> ((_,x),(x,_)) : set 0 for id F (1,0,1) -> ((_,x),(x,_)) : set 0 for id
G (1,1,0) -> ((_,_),(_,_)) : nop G (1,1,0) -> ((_,_),(_,_)) : nop
H (1,1,1) -> ((_,_),(x,_)) : set R for id H (1,1,1) -> ((_,_),(x,_)) : set R for id
I (2,0,0) -> ((_,x),(_,x)) : set 0 for id I (2,0,0) -> ((_,x),(_,x)) : set 0 for id
J (2,0,1) -> ((_,x),(_,_)) : set 0 for id J (2,0,1) -> ((_,x),(_,_)) : set 0 for id
K (2,1,0) -> ((_,_),(_,x)) : set F for id K (2,1,0) -> ((_,_),(_,x)) : set F for id
L (2,1,1) -> ((_,_),(_,_)) : nop L (2,1,1) -> ((_,_),(_,_)) : nop
PROBLEM: B & H in conflict! (Note that nop is automatic except for case B) PROBLEM: B & H in conflict! (Note that nop is automatic except for case B)
Results: Results:
set to 0: determined by vorfeld-unset -- zuerst set to 0: determined by vorfeld-unset -- zuerst
set to 1: vorfeld-set && nicht in rollfeld-set || rollfeld-unset && nicht in vorfeld-unset set to 1: vorfeld-set && nicht in rollfeld-set || rollfeld-unset && nicht in vorfeld-unset
set to 2: rollfeld-set && nicht in vorfeld-unset && (in vorfeld-set || AVS_Licence>0 == vorORrollfeld) set to 2: rollfeld-set && nicht in vorfeld-unset && (in vorfeld-set || AVS_Licence>0 == vorORrollfeld)
-} -}
-- | Always update AVS Data -- | Always update AVS Data
upsertAvsUser :: Text -> Handler (Maybe UserId) -- TODO: change to Entity upsertAvsUser :: Text -> Handler (Maybe UserId) -- TODO: change to Entity
@ -246,7 +247,7 @@ upsertAvsUser (discernAvsCardPersonalNo -> Just someid) = upsertAvsUserByCard so
upsertAvsUser otherId = -- attempt LDAP lookup to find by eMail upsertAvsUser otherId = -- attempt LDAP lookup to find by eMail
try (runDB $ ldapLookupAndUpsert otherId) >>= \case try (runDB $ ldapLookupAndUpsert otherId) >>= \case
Right Entity{entityVal=User{userCompanyPersonalNumber=Just persNo}} -> upsertAvsUserByCard (Right $ mkAvsInternalPersonalNo persNo) Right Entity{entityVal=User{userCompanyPersonalNumber=Just persNo}} -> upsertAvsUserByCard (Right $ mkAvsInternalPersonalNo persNo)
Left (_err::SomeException) -> return Nothing -- TODO: ; merely for convenience, not necessary right now Left (_err::SomeException) -> return Nothing -- TODO: ; merely for convenience, not necessary right now
_ -> return Nothing _ -> return Nothing
@ -262,7 +263,7 @@ upsertAvsUserByCard persNo = do
case Set.elems adps of case Set.elems adps of
[] -> throwM AvsPersonSearchEmpty [] -> throwM AvsPersonSearchEmpty
(_:_:_) -> throwM AvsPersonSearchAmbiguous (_:_:_) -> throwM AvsPersonSearchAmbiguous
[AvsDataPerson{avsPersonPersonID=api}] -> upsertAvsUserById api -- always trigger an update [AvsDataPerson{avsPersonPersonID=api}] -> upsertAvsUserById api -- always trigger an update
-- do -- do
-- mbuid <- runDB $ getBy $ UniqueUserAvsId api -- mbuid <- runDB $ getBy $ UniqueUserAvsId api
-- case mbuid of -- case mbuid of
@ -299,9 +300,9 @@ upsertAvsUserById api = do
(Nothing, Just AvsDataPerson{..}) -> do -- No LDAP User, but found in AVS; create new user (Nothing, Just AvsDataPerson{..}) -> do -- No LDAP User, but found in AVS; create new user
let firmAddress = guessLicenceAddress avsPersonPersonCards let firmAddress = guessLicenceAddress avsPersonPersonCards
mbCompany = firmAddress ^? _Just . _1 . _Just mbCompany = firmAddress ^? _Just . _1 . _Just
userFirmAddr= plaintextToStoredMarkup . mergeCompanyAddress <$> firmAddress userFirmAddr= plaintextToStoredMarkup . mergeCompanyAddress <$> firmAddress
pinCard = Set.lookupMax avsPersonPersonCards pinCard = Set.lookupMax avsPersonPersonCards
userPin = tshowAvsFullCardNo . getFullCardNo <$> pinCard userPin = tshowAvsFullCardNo . getFullCardNo <$> pinCard
fakeIdent = CI.mk $ "AVSID:" <> tshow api fakeIdent = CI.mk $ "AVSID:" <> tshow api
fakeNo = CI.mk $ "AVSNO:" <> tshow avsPersonPersonNo fakeNo = CI.mk $ "AVSNO:" <> tshow avsPersonPersonNo
newUsr = AdminUserForm newUsr = AdminUserForm
@ -323,32 +324,32 @@ upsertAvsUserById api = do
, aufIdent = fakeIdent -- use AvsPersonId instead , aufIdent = fakeIdent -- use AvsPersonId instead
, aufAuth = maybe AuthKindNoLogin (const AuthKindLDAP) avsPersonInternalPersonalNo -- FUTURE TODO: if email is known, use AuthKinfPWHash for email invite, if no internal personal number is known , aufAuth = maybe AuthKindNoLogin (const AuthKindLDAP) avsPersonInternalPersonalNo -- FUTURE TODO: if email is known, use AuthKinfPWHash for email invite, if no internal personal number is known
} }
mbUid <- addNewUser newUsr -- triggers JobSynchroniseLdapUser, JobSendPasswordReset and NotificationUserAutoModeUpdate -- TODO: check if these are failsafe mbUid <- addNewUser newUsr -- triggers JobSynchroniseLdapUser, JobSendPasswordReset and NotificationUserAutoModeUpdate -- TODO: check if these are failsafe
whenIsJust mbUid $ \uid -> runDB $ do whenIsJust mbUid $ \uid -> runDB $ do
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
insert_ $ UserAvs avsPersonPersonID uid avsPersonPersonNo insert_ $ UserAvs avsPersonPersonID uid avsPersonPersonNo
forM_ avsPersonPersonCards $ -- save all cards for later forM_ avsPersonPersonCards $ -- save all cards for later
-- let cs :: Set AvsDataPersonCard = Set.fromList $ catMaybes [pinCard, addrCard] -- let cs :: Set AvsDataPersonCard = Set.fromList $ catMaybes [pinCard, addrCard]
-- forM_ cs $ -- only save used cards for the postal address update detection -- forM_ cs $ -- only save used cards for the postal address update detection
\avsCard -> insert_ $ UserAvsCard avsPersonPersonID (avsDataCardNo avsCard) avsCard now \avsCard -> insert_ $ UserAvsCard avsPersonPersonID (avsDataCardNo avsCard) avsCard now
upsertUserCompany uid mbCompany upsertUserCompany uid mbCompany
return mbUid return mbUid
(Just (Entity _ UserAvs{userAvsUser=uid}), Just AvsDataPerson{avsPersonPersonCards}) -> do -- known user, update address and pinPassword (Just (Entity _ UserAvs{userAvsUser=uid}), Just AvsDataPerson{avsPersonPersonCards}) -> do -- known user, update address and pinPassword
let firmAddress = guessLicenceAddress avsPersonPersonCards let firmAddress = guessLicenceAddress avsPersonPersonCards
mbCompany = firmAddress ^? _Just . _1 . _Just mbCompany = firmAddress ^? _Just . _1 . _Just
mbCoFirmAddr= mergeCompanyAddress <$> firmAddress mbCoFirmAddr= mergeCompanyAddress <$> firmAddress
userFirmAddr= plaintextToStoredMarkup <$> mbCoFirmAddr userFirmAddr= plaintextToStoredMarkup <$> mbCoFirmAddr
pinCard = Set.lookupMax avsPersonPersonCards pinCard = Set.lookupMax avsPersonPersonCards
userPin = tshowAvsFullCardNo . getFullCardNo <$> pinCard userPin = tshowAvsFullCardNo . getFullCardNo <$> pinCard
runDB $ do runDB $ do
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
oldCards <- selectList [UserAvsCardPersonId ==. api] [] oldCards <- selectList [UserAvsCardPersonId ==. api] []
let oldAddrs = Set.fromList $ mapMaybe (maybeCompanyAddress . userAvsCardCard . entityVal) oldCards let oldAddrs = Set.fromList $ mapMaybe (maybeCompanyAddress . userAvsCardCard . entityVal) oldCards
unless (maybe True (`Set.member` oldAddrs) mbCoFirmAddr) $ do -- update postal address, unless the exact address had been seen before unless (maybe True (`Set.member` oldAddrs) mbCoFirmAddr) $ do -- update postal address, unless the exact address had been seen before
updateWhere [UserId ==. uid] [UserPostAddress =. userFirmAddr] updateWhere [UserId ==. uid] [UserPostAddress =. userFirmAddr]
whenIsJust pinCard $ \pCard -> -- update pin, but only if it was unset or set to the value of an old card whenIsJust pinCard $ \pCard -> -- update pin, but only if it was unset or set to the value of an old card
unlessM (exists [UserAvsCardCardNo ==. avsDataCardNo pCard]) $ do unlessM (exists [UserAvsCardCardNo ==. avsDataCardNo pCard]) $ do
let oldPins = Just . tshowAvsFullCardNo . getFullCardNo . userAvsCardCard . entityVal <$> oldCards let oldPins = Just . tshowAvsFullCardNo . getFullCardNo . userAvsCardCard . entityVal <$> oldCards
updateWhere [UserId ==. uid, UserPinPassword !=. userPin, UserPinPassword <-. Nothing:oldPins] updateWhere [UserId ==. uid, UserPinPassword !=. userPin, UserPinPassword <-. Nothing:oldPins]
[UserPinPassword =. userPin] [UserPinPassword =. userPin]
@ -362,7 +363,7 @@ upsertAvsUserById api = do
} }
[ UserAvsCardCard =. aCard [ UserAvsCardCard =. aCard
, UserAvsCardLastSynch =. now , UserAvsCardLastSynch =. now
] ]
return $ Just uid return $ Just uid
@ -388,3 +389,26 @@ lookupAvsUsers apis = do
AvsResponsePerson adps <- throwLeftM . avsQueryPerson $ def{avsPersonQueryCardNo = Just avsDataCardNo, avsPersonQueryVersionNo = Just avsDataVersionNo} AvsResponsePerson adps <- throwLeftM . avsQueryPerson $ def{avsPersonQueryCardNo = Just avsDataCardNo, avsPersonQueryVersionNo = Just avsDataVersionNo}
return $ mergeByPersonId adps acc2 return $ mergeByPersonId adps acc2
-- | Like `Handler.Utils.getReceivers`, but calls upsertAvsUserById on each user to ensure that postal address is up-to-date
updateReceivers :: UserId -> Handler (Entity User, [Entity User], Bool)
updateReceivers uid = do
(underling :: Entity User, avsUnderling :: Maybe (Entity UserAvs), avsSupers :: [Entity UserAvs]) <- runDB $ (,,)
<$> getJustEntity uid
<*> getBy (UniqueUserAvsUser uid)
<*> (E.select $ do
(usrSuper :& usrAvs) <-
E.from $ E.table @UserSupervisor
`E.innerJoin` E.table @UserAvs
`E.on` (\(usrSuper :& userAvs) ->usrSuper E.^. UserSupervisorSupervisor E.==. userAvs E.^. UserAvsUser)
E.where_ $ (usrSuper E.^. UserSupervisorUser E.==. E.val uid)
E.&&. (usrSuper E.^. UserSupervisorRerouteNotifications)
pure usrAvs
)
let toUpdate = Set.fromList (userAvsPersonId . entityVal <$> mcons avsUnderling avsSupers)
forM_ toUpdate (void . upsertAvsUserById) -- update postaddress from AVS
let receiverIDs :: [UserId] = userAvsUser . entityVal <$> avsSupers
receivers <- runDB (catMaybes <$> mapM getEntity receiverIDs)
return $ if null receivers
then (underling, pure underling, True)
else (underling, receivers, underling `elem` receivers)

70
src/Handler/Utils/Users.hs
View File

@ -47,14 +47,13 @@ import qualified Data.Text as Text
import Jobs.Types(Job, JobChildren) import Jobs.Types(Job, JobChildren)
abbrvName :: User -> Text abbrvName :: User -> Text
abbrvName User{userDisplayName, userFirstName, userSurname} = abbrvName User{userDisplayName, userFirstName, userSurname} =
if | (lastDisplayName : tsrif) <- reverse nameParts if | (lastDisplayName : tsrif) <- reverse nameParts
-> assemble $ reverse $ lastDisplayName : abbreviate tsrif -> assemble $ reverse $ lastDisplayName : abbreviate tsrif
| otherwise | otherwise
-> assemble $ abbreviate (Text.words userFirstName) <> [userSurname] -> assemble $ abbreviate (Text.words userFirstName) <> [userSurname]
where where
nameParts = Text.words userDisplayName nameParts = Text.words userDisplayName
abbreviate = fmap (Text.take 1) abbreviate = fmap (Text.take 1)
assemble = Text.intercalate "." assemble = Text.intercalate "."
@ -72,11 +71,11 @@ userPrefersEmail = not . userPrefersLetter
getPostalPreferenceAndAddress :: User -> (Bool, Maybe [Text]) getPostalPreferenceAndAddress :: User -> (Bool, Maybe [Text])
getPostalPreferenceAndAddress usr@User{..} = getPostalPreferenceAndAddress usr@User{..} =
(((userPrefersPostal || isNothing userPinPassword) && postPossible) || emailImpossible, pa) (((userPrefersPostal || isNothing userPinPassword) && postPossible) || emailImpossible, pa)
where where
orgEmail = CI.original userEmail orgEmail = CI.original userEmail
emailImpossible = not ('@' `textElem` orgEmail && '.' `textElem` orgEmail) emailImpossible = not ('@' `textElem` orgEmail && '.' `textElem` orgEmail)
postPossible = isJust pa postPossible = isJust pa
pa = getPostalAddress usr pa = getPostalAddress usr
getPostalAddress :: User -> Maybe [Text] getPostalAddress :: User -> Maybe [Text]
getPostalAddress User{..} getPostalAddress User{..}
@ -85,22 +84,23 @@ getPostalAddress User{..}
| Just abt <- userCompanyDepartment | Just abt <- userCompanyDepartment
= Just $ if | "BVD" `isPrefixOf` abt -> [userDisplayName, abt, "Bodenverkehrsdienste"] = Just $ if | "BVD" `isPrefixOf` abt -> [userDisplayName, abt, "Bodenverkehrsdienste"]
| otherwise -> [userDisplayName, abt, "Hausbriefkasten" ] | otherwise -> [userDisplayName, abt, "Hausbriefkasten" ]
| otherwise | otherwise
= Nothing = Nothing
-- | Return Entity User and all Supervisors with rerouteNotifications as well as -- | DEPRECATED, use Handler.Utis.Avs. updateReceivers instead
-- Return Entity User and all Supervisors with rerouteNotifications as well as
-- a boolean indicating if the user is own supervisor with rerouteNotifications -- a boolean indicating if the user is own supervisor with rerouteNotifications
getReceivers :: UserId -> DB (Entity User, [Entity User], Bool) getReceivers :: UserId -> DB (Entity User, [Entity User], Bool)
getReceivers uid = do getReceivers uid = do
underling <- getJustEntity uid underling <- getJustEntity uid
superVs <- selectList [UserSupervisorUser ==. uid, UserSupervisorRerouteNotifications ==. True] [] superVs <- selectList [UserSupervisorUser ==. uid, UserSupervisorRerouteNotifications ==. True] []
let superIds = userSupervisorSupervisor . entityVal <$> superVs let superIds = userSupervisorSupervisor . entityVal <$> superVs
if null superIds if null superIds
then return (underling, [underling], True) then return (underling, [underling], True)
else do else do
supers <- selectList [UserId <-. superIds] [] supers <- selectList [UserId <-. superIds] []
if null supers then return (underling, [underling], True) if null supers then return (underling, [underling], True)
else else
return (underling, supers, uid `elem` (entityKey <$> supers)) return (underling, supers, uid `elem` (entityKey <$> supers))
@ -152,7 +152,7 @@ matchesName (repack -> haystack) (repack -> needle)
guessUser :: PredDNF GuessUserInfo -- ^ guessing criteria guessUser :: PredDNF GuessUserInfo -- ^ guessing criteria
-> Maybe Int64 -- ^ Should the query be limited to a maximum number of results? -> Maybe Int64 -- ^ Should the query be limited to a maximum number of results?
-> DB (Maybe (Either (NonEmpty (Entity User)) (Entity User))) -- ^ Just (Left _) in case of multiple results, -> DB (Maybe (Either (NonEmpty (Entity User)) (Entity User))) -- ^ Just (Left _) in case of multiple results,
-- Just (Right _) in case of single result, and -- Just (Right _) in case of single result, and
-- Nothing in case of no result -- Nothing in case of no result
guessUser (((Set.toList . toNullable) <$>) . Set.toList . dnfTerms -> criteria) mQueryLimit = $cachedHereBinary criteria $ go False guessUser (((Set.toList . toNullable) <$>) . Set.toList . dnfTerms -> criteria) mQueryLimit = $cachedHereBinary criteria $ go False
@ -161,7 +161,7 @@ guessUser (((Set.toList . toNullable) <$>) . Set.toList . dnfTerms -> criteria)
asWords = filter (not . Text.null) . Text.words . Text.strip asWords = filter (not . Text.null) . Text.words . Text.strip
containsAsSet x y = E.and . map (\y' -> x `E.hasInfix` E.val y') $ asWords y containsAsSet x y = E.and . map (\y' -> x `E.hasInfix` E.val y') $ asWords y
toSql user pl = bool id E.not_ (is _PLNegated pl) $ case pl ^. _plVar of toSql user pl = bool id E.not_ (is _PLNegated pl) $ case pl ^. _plVar of
GuessUserMatrikelnummer userMatriculation' -> user E.^. UserMatrikelnummer E.==. E.val (Just userMatriculation') GuessUserMatrikelnummer userMatriculation' -> user E.^. UserMatrikelnummer E.==. E.val (Just userMatriculation')
GuessUserEduPersonPrincipalName userEPPN' -> user E.^. UserLdapPrimaryKey E.==. E.val (Just userEPPN') GuessUserEduPersonPrincipalName userEPPN' -> user E.^. UserLdapPrimaryKey E.==. E.val (Just userEPPN')
@ -184,7 +184,7 @@ guessUser (((Set.toList . toNullable) <$>) . Set.toList . dnfTerms -> criteria)
$ criteria ^.. folded) $ criteria ^.. folded)
closeness :: Entity User -> Entity User -> Ordering closeness :: Entity User -> Entity User -> Ordering
closeness ul ur = maximum $ impureNonNull $ criteria <&> \term -> closeness ul ur = maximum $ impureNonNull $ criteria <&> \term ->
let let
matches userField name = _entityVal . userField . to (`matchesName` name) matches userField name = _entityVal . userField . to (`matchesName` name)
comp True userField guess = (term ^.. folded . _PLVariable . guess) <&> \name -> comp True userField guess = (term ^.. folded . _PLVariable . guess) <&> \name ->
@ -203,7 +203,7 @@ guessUser (((Set.toList . toNullable) <$>) . Set.toList . dnfTerms -> criteria)
] ]
, b <- [True,False] , b <- [True,False]
] ]
-- Assuming the input list is sorted in descending order by closeness: -- Assuming the input list is sorted in descending order by closeness:
takeClosest [] = [] takeClosest [] = []
takeClosest [x] = [x] takeClosest [x] = [x]
@ -235,7 +235,7 @@ guessUser (((Set.toList . toNullable) <$>) . Set.toList . dnfTerms -> criteria)
convertLdapResults [] = Nothing convertLdapResults [] = Nothing
convertLdapResults [x] = Just $ Right x convertLdapResults [x] = Just $ Right x
convertLdapResults xs = Just $ Left $ NonEmpty.fromList xs convertLdapResults xs = Just $ Left $ NonEmpty.fromList xs
if if
| [x] <- users' | [x] <- users'
, Just True == matchesMatriculation x || didLdap , Just True == matchesMatriculation x || didLdap
@ -282,9 +282,9 @@ assimilateUser :: UserId -- ^ @newUserId@
-- ^ Move all relevant properties (submissions, corrections, grades, ...) from @oldUserId@ to @newUserId@ -- ^ Move all relevant properties (submissions, corrections, grades, ...) from @oldUserId@ to @newUserId@
-- --
-- Fatal errors are thrown, non-fatal warnings are returned -- Fatal errors are thrown, non-fatal warnings are returned
assimilateUser newUserId oldUserId = mapReaderT execWriterT $ do assimilateUser newUserId oldUserId = mapReaderT execWriterT $ do
E.insertSelectWithConflict E.insertSelectWithConflict
UniqueCourseFavourite UniqueCourseFavourite
(E.from $ \courseFavourite -> do (E.from $ \courseFavourite -> do
E.where_ $ courseFavourite E.^. CourseFavouriteUser E.==. E.val oldUserId E.where_ $ courseFavourite E.^. CourseFavouriteUser E.==. E.val oldUserId
return $ CourseFavourite return $ CourseFavourite
@ -414,7 +414,7 @@ assimilateUser newUserId oldUserId = mapReaderT execWriterT $ do
) )
(\_current _excluded -> []) (\_current _excluded -> [])
deleteWhere [ SubmissionUserUser ==. oldUserId ] deleteWhere [ SubmissionUserUser ==. oldUserId ]
do do
collisions <- E.select . E.from $ \((submissionGroupUserA `E.InnerJoin` submissionGroupA) `E.InnerJoin` (submissionGroupUserB `E.InnerJoin` submissionGroupB)) -> do collisions <- E.select . E.from $ \((submissionGroupUserA `E.InnerJoin` submissionGroupA) `E.InnerJoin` (submissionGroupUserB `E.InnerJoin` submissionGroupB)) -> do
E.on $ submissionGroupB E.^. SubmissionGroupId E.==. submissionGroupUserB E.^. SubmissionGroupUserSubmissionGroup E.on $ submissionGroupB E.^. SubmissionGroupId E.==. submissionGroupUserB E.^. SubmissionGroupUserSubmissionGroup
@ -659,7 +659,7 @@ assimilateUser newUserId oldUserId = mapReaderT execWriterT $ do
) )
(\current excluded -> [ ExamPartResultLastChanged E.=. E.max (current E.^. ExamPartResultLastChanged) (excluded E.^. ExamPartResultLastChanged) ]) (\current excluded -> [ ExamPartResultLastChanged E.=. E.max (current E.^. ExamPartResultLastChanged) (excluded E.^. ExamPartResultLastChanged) ])
deleteWhere [ ExamPartResultUser ==. oldUserId ] deleteWhere [ ExamPartResultUser ==. oldUserId ]
do do
collision <- E.selectMaybe . E.from $ \(examBonusA `E.InnerJoin` examBonusB) -> do collision <- E.selectMaybe . E.from $ \(examBonusA `E.InnerJoin` examBonusB) -> do
E.on $ examBonusA E.^. ExamBonusExam E.==. examBonusB E.^. ExamBonusExam E.on $ examBonusA E.^. ExamBonusExam E.==. examBonusB E.^. ExamBonusExam
@ -681,7 +681,7 @@ assimilateUser newUserId oldUserId = mapReaderT execWriterT $ do
) )
(\current excluded -> [ ExamBonusLastChanged E.=. E.max (current E.^. ExamBonusLastChanged) (excluded E.^. ExamBonusLastChanged) ]) (\current excluded -> [ ExamBonusLastChanged E.=. E.max (current E.^. ExamBonusLastChanged) (excluded E.^. ExamBonusLastChanged) ])
deleteWhere [ ExamBonusUser ==. oldUserId ] deleteWhere [ ExamBonusUser ==. oldUserId ]
let getExamResults = selectSource [ ExamResultUser ==. oldUserId ] [] let getExamResults = selectSource [ ExamResultUser ==. oldUserId ] []
upsertExamResult oldEREnt@(Entity oldERId oldER) = do upsertExamResult oldEREnt@(Entity oldERId oldER) = do
newER' <- getBy $ UniqueExamResult (examResultExam oldER) newUserId newER' <- getBy $ UniqueExamResult (examResultExam oldER) newUserId
@ -847,19 +847,19 @@ assimilateUser newUserId oldUserId = mapReaderT execWriterT $ do
delete oldSFId delete oldSFId
in runConduit $ getStudyFeatures .| C.mapM_ upsertStudyFeatures in runConduit $ getStudyFeatures .| C.mapM_ upsertStudyFeatures
-- Qualifications and ongoing LMS -- Qualifications and ongoing LMS
-- LmsUser: insertSelectWithConflict impossible due to 2 simultaneous uniqueness constraints; UniqueLmsIdent requires proper update, prohibits insert and then delete -- LmsUser: insertSelectWithConflict impossible due to 2 simultaneous uniqueness constraints; UniqueLmsIdent requires proper update, prohibits insert and then delete
-- updateWhere [ LmsUserUser ==. oldUserId ] [ LmsUserUser =. newUserId ] -- might fail due to UniqueLmsQualficationUuser -- updateWhere [ LmsUserUser ==. oldUserId ] [ LmsUserUser =. newUserId ] -- might fail due to UniqueLmsQualficationUuser
oldLms <- selectList [ LmsUserUser ==. oldUserId ] [ Asc LmsUserQualification ] oldLms <- selectList [ LmsUserUser ==. oldUserId ] [ Asc LmsUserQualification ]
newLms <- selectList [ LmsUserUser ==. newUserId ] [ Asc LmsUserQualification ] newLms <- selectList [ LmsUserUser ==. newUserId ] [ Asc LmsUserQualification ]
let projQ = lmsUserQualification . entityVal let projQ = lmsUserQualification . entityVal
oldQs = Set.fromList (projQ <$> oldLms) oldQs = Set.fromList (projQ <$> oldLms)
newQs = Set.fromList (projQ <$> newLms) newQs = Set.fromList (projQ <$> newLms)
qConflicts = oldQs `Set.intersection` newQs qConflicts = oldQs `Set.intersection` newQs
qResolvable = Set.fromList [ lmsUserQualification | Entity _ LmsUser{..} <- oldLms, isJust lmsUserEnded, lmsUserQualification `Set.member` qConflicts ] qResolvable = Set.fromList [ lmsUserQualification | Entity _ LmsUser{..} <- oldLms, isJust lmsUserEnded, lmsUserQualification `Set.member` qConflicts ]
qProblems = qConflicts `Set.difference` qResolvable qProblems = qConflicts `Set.difference` qResolvable
unless (Set.null qProblems) $ tellError $ UserAssimilateConflictingLmsQualifications qProblems unless (Set.null qProblems) $ tellError $ UserAssimilateConflictingLmsQualifications qProblems
unless (Set.null qResolvable) $ deleteWhere [ LmsUserUser ==. oldUserId, LmsUserQualification <-. Set.toList qResolvable ] -- delete conflicting and finished LMS, which are still within auditDuration unless (Set.null qResolvable) $ deleteWhere [ LmsUserUser ==. oldUserId, LmsUserQualification <-. Set.toList qResolvable ] -- delete conflicting and finished LMS, which are still within auditDuration
updateWhere [ LmsUserUser ==. oldUserId ] [ LmsUserUser =. newUserId ] updateWhere [ LmsUserUser ==. oldUserId ] [ LmsUserUser =. newUserId ]
updateWhere [ QualificationEditUser ==. oldUserId ] [ QualificationEditUser =. newUserId ] updateWhere [ QualificationEditUser ==. oldUserId ] [ QualificationEditUser =. newUserId ]
E.insertSelectWithConflict E.insertSelectWithConflict
@ -874,19 +874,19 @@ assimilateUser newUserId oldUserId = mapReaderT execWriterT $ do
E.<&> (qualificationUser E.^. QualificationUserFirstHeld) E.<&> (qualificationUser E.^. QualificationUserFirstHeld)
E.<&> (qualificationUser E.^. QualificationUserBlockedDue) E.<&> (qualificationUser E.^. QualificationUserBlockedDue)
) )
(\current excluded -> (\current excluded ->
[ QualificationUserValidUntil E.=. combineWith current excluded E.greatest QualificationUserValidUntil [ QualificationUserValidUntil E.=. combineWith current excluded E.greatest QualificationUserValidUntil
, QualificationUserLastRefresh E.=. combineWith current excluded E.greatest QualificationUserLastRefresh , QualificationUserLastRefresh E.=. combineWith current excluded E.greatest QualificationUserLastRefresh
, QualificationUserFirstHeld E.=. combineWith current excluded E.least QualificationUserFirstHeld , QualificationUserFirstHeld E.=. combineWith current excluded E.least QualificationUserFirstHeld
, QualificationUserBlockedDue E.=. combineWith current excluded E.greatest QualificationUserBlockedDue -- Tested: PostgreSQL GREATEST/LEAST ignores NULL values , QualificationUserBlockedDue E.=. combineWith current excluded E.greatest QualificationUserBlockedDue -- Tested: PostgreSQL GREATEST/LEAST ignores NULL values
] ]
) )
deleteWhere [ QualificationUserUser ==. oldUserId ] deleteWhere [ QualificationUserUser ==. oldUserId ]
-- Supervision is fully merged -- Supervision is fully merged
E.insertSelectWithConflict E.insertSelectWithConflict
UniqueUserSupervisor UniqueUserSupervisor
(E.from $ \userSupervisor -> do (E.from $ \userSupervisor -> do
E.where_ $ userSupervisor E.^. UserSupervisorSupervisor E.==. E.val oldUserId E.where_ $ userSupervisor E.^. UserSupervisorSupervisor E.==. E.val oldUserId
return $ UserSupervisor return $ UserSupervisor
E.<# E.val newUserId E.<# E.val newUserId
@ -894,11 +894,11 @@ assimilateUser newUserId oldUserId = mapReaderT execWriterT $ do
E.<&> (userSupervisor E.^. UserSupervisorRerouteNotifications) E.<&> (userSupervisor E.^. UserSupervisorRerouteNotifications)
) )
(\current excluded -> [ UserSupervisorRerouteNotifications E.=. (current E.^. UserSupervisorRerouteNotifications E.||. excluded E.^. UserSupervisorRerouteNotifications) ] ) (\current excluded -> [ UserSupervisorRerouteNotifications E.=. (current E.^. UserSupervisorRerouteNotifications E.||. excluded E.^. UserSupervisorRerouteNotifications) ] )
deleteWhere [ UserSupervisorSupervisor ==. oldUserId] deleteWhere [ UserSupervisorSupervisor ==. oldUserId]
E.insertSelectWithConflict E.insertSelectWithConflict
UniqueUserSupervisor UniqueUserSupervisor
(E.from $ \userSupervisor -> do (E.from $ \userSupervisor -> do
E.where_ $ userSupervisor E.^. UserSupervisorUser E.==. E.val oldUserId E.where_ $ userSupervisor E.^. UserSupervisorUser E.==. E.val oldUserId
return $ UserSupervisor return $ UserSupervisor
E.<# (userSupervisor E.^. UserSupervisorSupervisor) E.<# (userSupervisor E.^. UserSupervisorSupervisor)
@ -906,14 +906,14 @@ assimilateUser newUserId oldUserId = mapReaderT execWriterT $ do
E.<&> (userSupervisor E.^. UserSupervisorRerouteNotifications) E.<&> (userSupervisor E.^. UserSupervisorRerouteNotifications)
) )
(\current excluded -> [ UserSupervisorRerouteNotifications E.=. (current E.^. UserSupervisorRerouteNotifications E.||. excluded E.^. UserSupervisorRerouteNotifications) ] ) (\current excluded -> [ UserSupervisorRerouteNotifications E.=. (current E.^. UserSupervisorRerouteNotifications E.||. excluded E.^. UserSupervisorRerouteNotifications) ] )
deleteWhere [ UserSupervisorUser ==. oldUserId] deleteWhere [ UserSupervisorUser ==. oldUserId]
-- Companies, in conflict, keep the newUser-Company as is -- Companies, in conflict, keep the newUser-Company as is
E.insertSelectWithConflict E.insertSelectWithConflict
UniqueUserCompany UniqueUserCompany
(E.from $ \userCompany -> do (E.from $ \userCompany -> do
E.where_ $ userCompany E.^. UserCompanyUser E.==. E.val oldUserId E.where_ $ userCompany E.^. UserCompanyUser E.==. E.val oldUserId
return $ UserCompany return $ UserCompany
E.<# E.val newUserId E.<# E.val newUserId
E.<&> (userCompany E.^. UserCompanyCompany) E.<&> (userCompany E.^. UserCompanyCompany)
E.<&> (userCompany E.^. UserCompanySupervisor) E.<&> (userCompany E.^. UserCompanySupervisor)
@ -949,4 +949,4 @@ combineWith :: (PersistEntity val, PersistField typ1) =>
-> (E.SqlExpr (E.Value typ1) -> E.SqlExpr (E.Value typ1) -> E.SqlExpr (E.Value typ2)) -> (E.SqlExpr (E.Value typ1) -> E.SqlExpr (E.Value typ1) -> E.SqlExpr (E.Value typ2))
-> EntityField val typ1 -> EntityField val typ1
-> E.SqlExpr (E.Value typ2) -> E.SqlExpr (E.Value typ2)
combineWith x y f pj = f (x E.^. pj) (y E.^. pj) combineWith x y f pj = f (x E.^. pj) (y E.^. pj)

2
src/Utils/Print.hs
View File

@ -413,7 +413,7 @@ instance MDLetter LetterRenewQualificationF where
sendEmailOrLetter :: (MDLetter l) => UserId -> l -> Handler Bool sendEmailOrLetter :: (MDLetter l) => UserId -> l -> Handler Bool
sendEmailOrLetter recipient letter = do sendEmailOrLetter recipient letter = do
(underling, receivers, undercopy) <- liftHandler . runDB $ getReceivers recipient (underling, receivers, undercopy) <- runDB $ getReceivers recipient
let tmpl = getTemplate $ pure letter let tmpl = getTemplate $ pure letter
pjid = getPJId letter pjid = getPJId letter
-- Below are only needed if sent by email -- Below are only needed if sent by email