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

refactor(avs): complete createAvsUserById

Browse Source
This commit is contained in:
Steffen Jost 2024-04-18 18:02:16 +02:00
parent 234dd28f48
commit b7af6312f9
5 changed files with 92 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
messages/uniworx/categories/avs/de-de-formal.msg
View File

@ -47,4 +47,5 @@ AvsUserAmbiguous api@AvsPersonId: AVS Id #{tshow api} ist nicht eindeutig
AvsPersonSearchEmpty: AVS Suche lieferte leeres Ergebnis
AvsPersonSearchAmbiguous: AVS Suche lieferte mehrere uneindeutige Ergebnisse
AvsSetLicencesFailed reason@Text: Setzen der Fahrlizenz im AVS fehlgeschlagen. Grund: #{reason}
AvsIdMismatch api1@AvsPersonId api2@AvsPersonId: AVS Suche für Id #{tshow api1} lieferte stattdessen Id #{tshow api2}
AvsIdMismatch api1@AvsPersonId api2@AvsPersonId: AVS Suche für Id #{tshow api1} lieferte stattdessen Id #{tshow api2}
AvsUserCreationFailed api@AvsPersonId: Für AVS Id #{tshow api} konnte kein neuer Benutzer angelegt werden, da es eine gemeinsame Id (z.B. Personalnummer) mit einem existierenden, aber verschiedenen Nutzer gibt.

3
messages/uniworx/categories/avs/en-eu.msg
View File

@ -47,4 +47,5 @@ AvsUserAmbiguous api: Multiple matching users found for #{tshow api}
AvsPersonSearchEmpty: AVS search returned empty result
AvsPersonSearchAmbiguous: AVS search returned more than one result
AvsSetLicencesFailed reason: Set driving licence within AVS failed. Reason: #{reason}
AvsIdMismatch api1 api2: AVS search for id #{tshow api1} returned id #{tshow api2} instead
AvsIdMismatch api1 api2: AVS search for id #{tshow api1} returned id #{tshow api2} instead
AvsUserCreationFailed api@AvsPersonId: No new user could be created for AVS Id #{tshow api}, since an existing user shares at least one id presumed as unique

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

@ -75,8 +75,8 @@ data AvsException
| AvsPersonSearchEmpty -- AvsPersonSearch returned empty result
| AvsPersonSearchAmbiguous -- AvsPersonSearch returned more than one result
| AvsSetLicencesFailed Text -- AvsSetLicence total failure
| AvsIdMismatch AvsPersonId AvsPersonId -- First AVS Id was requested, but second one was returned for that query
-- | AvsUserCreationFailed
| AvsIdMismatch AvsPersonId AvsPersonId -- First AVS Id was requested, but second one was returned for that query
| AvsUserCreationFailed AvsPersonId
deriving (Show, Eq, Ord, Generic)
instance Exception AvsException
embedRenderMessage ''UniWorX ''AvsException id -- display as feedback for user initiated actions -- moved to Foundation.I18n
@ -360,7 +360,7 @@ updateReceivers uid = do
-- TODO #36 "company postal preference", but for updates only yet
--
-- TODO Adjust dispatchJobSYnchroniseAvsQueue to use updateAvsUserByIds directly, dealing with batches do
-- TODO: replace upsertAvsUserById with upsertAvsUserById0 and delete old code and old tables
-- | `SomeAvsQuery` is an umbrella to unify usage of all AVS queries, since Servant required separate types to fit the existing AVS-VSM API
class SomeAvsQuery q where
@ -615,61 +615,80 @@ updateAvsUserByIds apids0 = do
-- | Create new user from AVS-Id. Will throw an AvsException if this is not possible, e.g. due to Uniqueness Constraints
createAvsUserById :: AvsPersonId -> Handler UserId
createAvsUserById api = do
AvsResponseContact res <- avsQuery $ AvsQueryContact $ Set.singleton $ AvsObjPersonId api
case Set.toList res of
AvsResponseContact contactRes <- avsQuery $ AvsQueryContact $ Set.singleton $ AvsObjPersonId api
case Set.toList contactRes of
[] -> throwM $ AvsUserUnknownByAvs api
(_:_:_) -> throwM $ AvsUserAmbiguous api
[AvsDataContact{avsContactPersonInfo=cpi,..}]
[AvsDataContact{avsContactPersonInfo=cpi, avsContactFirmInfo=firmInfo, avsContactPersonID}]
| avsContactPersonID /= api -> throwM $ AvsIdMismatch api avsContactPersonID
| otherwise -> do
usrCardNo <- queryAvsFullCardNo api
let pinPass = avsFullCardNo2pin <$> usrCardNo
Entity{entityKey=cid, entityVal=cmp} <- runDB $ upsertAvsCompany avsContactFirmInfo Nothing -- individual runDB, since no need to rollback
-- check for matching existing user
let internalPersNo :: Maybe Text = cpi ^? _avsInfoInternalPersonalNo . _Just . _avsInternalPersonalNo
persMail :: Maybe UserEmail = cpi ^? _avsInfoPersonEMail . _Just . from _CI
newUserData = AddUserData
{ audTitle = Nothing
, audFirstName = cpi ^. _avsInfoFirstName & Text.strip
, audSurname = cpi ^. _avsInfoLastName & Text.strip
, audDisplayName = cpi ^. _avsInfoDisplayName
, audDisplayEmail = persMail & fromMaybe mempty
, audEmail = persMail & fromMaybe ("AVSNO:" <> cpi ^. _avsInfoPersonNo . from _CI)
, audIdent = persMail & fromMaybe ("AVSID:" <> ciShow api )
, audAuth = maybe AuthKindNoLogin (const AuthKindLDAP) internalPersNo
, audMatriculation = cpi ^. _avsInfoPersonNo & Just . tshow
, audSex = Nothing
, audBirthday = cpi ^. _avsInfoDateOfBirth
, audMobile = cpi ^. _avsInfoPersonMobilePhoneNo
, audTelephone = Nothing
, audFPersonalNumber = internalPersNo
, audFDepartment = toMaybe (isJust internalPersNo) (cmp ^. _companyShorthand . _CI)
, audPostAddress = Nothing -- use company address indirectly
, audPrefersPostal = cmp ^. _companyPrefersPostal
, audPinPassword = pinPass
}
persMail :: Maybe UserEmail = cpi ^? _avsInfoPersonEMail . _Just . from _CI
oldUsr <- runDB $ do
mbUid <- firstJustM $ catMaybes
[ internalPersNo <&> (\ipn -> getKeyByFilter [UserCompanyPersonalNumber ==. Just ipn]) -- must ensure filter isnt ==. Nothing
, persMail <&> guessUserByEmail
]
mbUAvs <- (getBy . UniqueUserAvsUser) `traverseJoin` mbUid
return (mbUid, mbUAvs)
usrCardNo <- queryAvsFullCardNo api
now <- liftIO getCurrentTime
runDB $ do -- any failure must rollback all DB write transactions
uid <- maybeThrowM AvsInterfaceUnavailable $ addNewUserDB newUserData
let userComp = UserCompany uid cid False False 1 True -- default value for new company insertion, if no update can be done
userCompId <- maybeThrowM AvsInterfaceUnavailable $ insertUnique userComp
-- TODO: link with existing user, if insertion failed?
-- TODO: write suitable exceptions, replacing all 3 AvsInterfaceUnavailable within this block
-- TODO: replace upsertAvsUserById with upsertAvsUserById0 and delete old code and old tables
-- Supervision
addCompanySupervisors cid uid
repsertSuperiorSupervisor (Just cid) avsContactFirmInfo uid
-- Save AVS data for future updates
userAvsId <- maybeThrowM AvsInterfaceUnavailable $ insertUnique UserAvs
let usrAvs uid mbFirmInfo = UserAvs
{ userAvsPersonId = api
, userAvsUser = uid
, userAvsNoPerson = fromMaybe (negate $ avsPersonId api) $ readMay $ cpi ^. _avsInfoPersonNo -- negative personId as fallback, but readMay should never fail
, userAvsLastSynch = now
, userAvsLastSynchError = Nothing
, userAvsLastPersonInfo = Just cpi
, userAvsLastFirmInfo = Just avsContactFirmInfo
, userAvsLastFirmInfo = mbFirmInfo
, userAvsLastCardNo = usrCardNo
}
case oldUsr of
(_ , Just Entity{entityVal=UserAvs{userAvsPersonId=api'}})
| api /= api' -> throwM $ AvsIdMismatch api api'
| otherwise -> throwM $ AvsUserUnknownByAvs api
(Just uid, Nothing) -> runDB $ do -- link with matching exisitng user
insert_ $ usrAvs uid Nothing -- company info should cause the user to be associated with the company during the update
updRes <- updateAvsUserByIds $ Set.singleton api -- no loop, since updateAvsUserByIds does not call createAvsUserById
case Set.toList updRes of
[(api',uid')] | api == api' -> return uid' -- && uid == uid' -> return uid
| otherwise -> throwM $ AvsIdMismatch api api'
[] -> throwM $ AvsUserUnknownByAvs api
_ -> throwM $ AvsUserAmbiguous api
(Nothing, Nothing) -> do
Entity{entityKey=cid, entityVal=cmp} <- runDB $ upsertAvsCompany firmInfo Nothing -- individual runDB, since no need to rollback
let pinPass = avsFullCardNo2pin <$> usrCardNo
newUserData = AddUserData
{ audTitle = Nothing
, audFirstName = cpi ^. _avsInfoFirstName & Text.strip
, audSurname = cpi ^. _avsInfoLastName & Text.strip
, audDisplayName = cpi ^. _avsInfoDisplayName
, audDisplayEmail = persMail & fromMaybe mempty
, audEmail = persMail & fromMaybe ("AVSNO:" <> cpi ^. _avsInfoPersonNo . from _CI)
, audIdent = persMail & fromMaybe ("AVSID:" <> ciShow api )
, audAuth = maybe AuthKindNoLogin (const AuthKindLDAP) internalPersNo
, audMatriculation = cpi ^. _avsInfoPersonNo & Just . tshow
, audSex = Nothing
, audBirthday = cpi ^. _avsInfoDateOfBirth
, audMobile = cpi ^. _avsInfoPersonMobilePhoneNo
, audTelephone = Nothing
, audFPersonalNumber = internalPersNo
, audFDepartment = toMaybe (isJust internalPersNo) (cmp ^. _companyShorthand . _CI)
, audPostAddress = Nothing -- always use company address indirectly
, audPrefersPostal = cmp ^. _companyPrefersPostal
, audPinPassword = pinPass
}
return $ seq userCompId $ seq userAvsId uid
runDB $ do -- any failure must rollback all DB write transactions here
uid <- maybeThrowM (AvsUserCreationFailed api) $ addNewUserDB newUserData
let userComp = UserCompany uid cid False False 1 True -- default value for new company insertion, if no update can be done
void $ insertUnique userComp -- Nothing indicates that the user is already linked to the company (which is unlikely here)
-- Supervision
addCompanySupervisors cid uid
repsertSuperiorSupervisor (Just cid) firmInfo uid
-- Save AVS data for future updates
insert_ $ usrAvs uid $ Just firmInfo -- unlikely that uid cannot be linked with avsid, but throw if it is not possible
return uid
-- | upsert superior by eMail through LDAP only (currently no email search available in AVS)
@ -762,12 +781,8 @@ guessAvsUser someid = do
other -> do -- attempt to recover by trying other ids
whenIsLeft other (\(err::SomeException) -> $logInfoS "AVS" $ "upsertAvsUser LDAP error " <> tshow err) -- this line primarily forces exception type to catch-all
runDB . runMaybeT $
let someIdent = stripCI someid -- also see Handler.Utils.guessUserByEmail for a similar function, this one is more lenient, since a unique email is acceptable, even it would not be unique as DisplayEmail
in MaybeT (getKeyBy $ UniqueEmail someIdent) -- recall that monadic actions are only executed until first success here
<|> MaybeT (getKeyBy $ UniqueAuthentication someIdent)
<|> MaybeT (getKeyByFilter [UserDisplayEmail ==. someIdent])
<|> MaybeT (getKeyBy $ UniqueLdapPrimaryKey $ Just someid)
<|> MaybeT (getKeyByFilter [UserDisplayName ==. someid])
MaybeT (guessUserByEmail $ stripCI someid) -- recall that monadic actions are only executed until first success here
<|> MaybeT (getKeyByFilter [UserDisplayName ==. someid])
-- | Given CardNo or internal Number, retrieve UserId. Create non-existing users, if possible. Always update.
@ -797,7 +812,7 @@ upsertAvsUserById0 api = do
[(api',uid)]
| api == api' -> return uid
| otherwise -> throwM $ AvsIdMismatch api api'
-- error $ "Handler.Utils.Avs.updateAvsUSerByIds returned unasked user with AvsPersonId " <> show api' <> " for queried AvsPersonId " <> show api <> "."
-- error $ "Handler.Utils.Avs.updateAvsUserByIds returned unasked user with AvsPersonId " <> show api' <> " for queried AvsPersonId " <> show api <> "."
(_:_:_) -> throwM $ AvsUserAmbiguous api

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

@ -200,14 +200,17 @@ getSupervisees = do
computeUserAuthenticationDigest :: AuthenticationMode -> Digest SHA3_256
computeUserAuthenticationDigest = hashlazy . JSON.encode
-- guessUserByCompanyPersonalNumber :: Text -> Text -> DB (Maybe UserId)
-- guessUserByCompanyPersonalNumber surname ipn = getKeyByFilter [UserCompanyPersonalNumber ==. Just ipn, UserSurname ==. surname]
guessUserByEmail :: UserEmail -> DB (Maybe UserId)
guessUserByEmail eml = getKeyByFilter $ ofoldl1Ex' (||.) $
mcons (getFraportLogin (CI.original eml) <&> (\lgi ->
[UserLdapPrimaryKey ==. Just lgi])) -- Note that we must exclude `==. Nothing` here!
[ [UserDisplayEmail ==. eml]
, [UserEmail ==. eml]
, [UserIdent ==. eml]
]
guessUserByEmail eml = firstJustM $
[ getKeyBy $ UniqueEmail eml
, getKeyBy $ UniqueAuthentication eml -- aka UserIdent
, getKeyByFilter [UserDisplayEmail ==. eml]
] <> maybeEmpty (getFraportLogin (CI.original eml)) (\lgi ->
[ getKeyBy $ UniqueLdapPrimaryKey $ Just lgi
])
data GuessUserInfo
= GuessUserMatrikelnummer

17
src/Handler/Utils/avs_callgraph.md
View File

@ -5,13 +5,16 @@
flowchart LR;
gau([guessAvsUser])
%% uau([XupsertAvsUser])
uaubi[?upsertAvsUserById]
uaubi[upsertAvsUserById]
uaubis[upsertAvsUserByIds]
uaubc[upsertAvsUserByCard]
ldap[[ldapLookupAndUpsert]]
lau[lookupAvsUser]
laus[lookupAvsUsers - DEPRECATED?]
gla[guessLicenceAddress - DEPRECATED]
ur([?updateReceivers])
caubi[createAvsUserById]
ucomp[upsertAvsCompany]
aqc{{AvsQueryContact}}
aqp{{AvsQueryPerson}}
@ -28,10 +31,14 @@ flowchart LR;
%% uau-..->uaubi
%% uau-..->uaubc
uaubi-.->lau
uaubi-.->ldap
uaubi-.->gla
uaubi-->aqc
uaubi-->uaubis
uaubi-->caubi-->uaubis
uaubis-->aqc
caubi-->aqs
caubi-->aqc
caubi-->ucomp
uaubis-->ucomp
lau-->laus
laus-->aqs