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

fix(avs): attempt LDAP upsert before creating avs users

Browse Source
This commit is contained in:
Steffen Jost 2024-08-29 16:15:16 +02:00
parent 64ff002ffb
commit cfe2318f81
1 changed files with 8 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -99,10 +99,10 @@ catchAVS2log :: (MonadHandler m, MonadCatch m, RenderMessage (HandlerSite m) Avs
catchAVS2log = catchAVShandler False True False Nothing catchAVS2log = catchAVShandler False True False Nothing
catchAll2log :: (MonadHandler m, MonadCatch m, RenderMessage (HandlerSite m) AvsException) => m a -> m () catchAll2log :: (MonadHandler m, MonadCatch m, RenderMessage (HandlerSite m) AvsException) => m a -> m ()
catchAll2log = voidMaybe $ catchAVShandler True True False Nothing catchAll2log = voidMaybe catchAll2log'
-- catchAll2log' :: (MonadHandler m, MonadCatch m, RenderMessage (HandlerSite m) AvsException, Monoid a) => m a -> m () catchAll2log' :: (MonadHandler m, MonadCatch m, RenderMessage (HandlerSite m) AvsException) => m (Maybe a) -> m (Maybe a)
-- catchAll2log' = voidMaybe $ catchAVShandler True True False mempty catchAll2log' = catchAVShandler True True False Nothing
catchAVShandler :: (MonadHandler m, MonadCatch m, RenderMessage (HandlerSite m) AvsException) => Bool -> Bool -> Bool -> a -> m a -> m a catchAVShandler :: (MonadHandler m, MonadCatch m, RenderMessage (HandlerSite m) AvsException) => Bool -> Bool -> Bool -> a -> m a -> m a
catchAVShandler allEx toLog toMsg dft act = act `catches` (avsHandlers <> allHandlers) catchAVShandler allEx toLog toMsg dft act = act `catches` (avsHandlers <> allHandlers)
@ -493,13 +493,12 @@ createAvsUserById muid api = do
-- check for matching existing user -- check for matching existing user
let internalPersNo :: Maybe Text = cpi ^? _avsInfoInternalPersonalNo . _Just . _avsInternalPersonalNo let internalPersNo :: Maybe Text = cpi ^? _avsInfoInternalPersonalNo . _Just . _avsInternalPersonalNo
-- persMail :: Maybe UserEmail = cpi ^? _avsInfoPersonEMail . _Just . from _CI -- persMail :: Maybe UserEmail = cpi ^? _avsInfoPersonEMail . _Just . from _CI
oldUsr <- runDBRead $ do oldUsr <- runDB $ do
mbUid <- if isJust muid mbUid <- firstJustM $ return muid : maybe [] (\ipn ->
then return muid [ getKeyByFilter [UserCompanyPersonalNumber ==. Just ipn] -- must ensure filter isnt ==. Nothing
else firstJustM $ catMaybes , catchAll2log' (Just . entityKey <$> ldapLookupAndUpsert ipn) -- attempt to insert by LDAP first
[ internalPersNo <&> (\ipn -> getKeyByFilter [UserCompanyPersonalNumber ==. Just ipn]) -- must ensure filter isnt ==. Nothing
-- , persMail <&> guessUserByEmail -- this did not work, as unfortunately, superiors are sometimes listed under _avsInfoPersonEMail!
] ]
) internalPersNo
mbUAvs <- (getBy . UniqueUserAvsUser) `traverseJoin` mbUid mbUAvs <- (getBy . UniqueUserAvsUser) `traverseJoin` mbUid
return (mbUid, mbUAvs) return (mbUid, mbUAvs)
usrCardNo <- queryAvsFullCardNo api usrCardNo <- queryAvsFullCardNo api