chore(avs): allow companies without postal address
This commit is contained in:
Steffen Jost
parent
430de83366
commit
c3b6d186c4
@ -23,6 +23,7 @@ UserAvs
|
||||
|
||||
-- Multiple UserAvsCards per UserAvs is possible and not too uncommon.
|
||||
-- Purpose of saving cards is to detect external changes in qualifications and postal addresses
|
||||
-- TODO: This table will be deleted if AVS CR3 SCF-165 is implemented
|
||||
UserAvsCard
|
||||
personId AvsPersonId
|
||||
cardNo AvsFullCardNo
|
||||
|
||||
@ -393,29 +393,28 @@ upsertAvsUserById api = do
|
||||
case (mbuid, mbapd) of
|
||||
( _ , Nothing ) -> throwM $ AvsUserUnknownByAvs api -- User not found in AVS at all, i.e. no valid card exists yet
|
||||
(Nothing, Just AvsDataPerson{avsPersonFirstName= Text.strip -> avsFirstName, avsPersonLastName= Text.strip -> avsSurname, ..}) -> do -- No LDAP User, but found in AVS; create new user
|
||||
let firmAddress = guessLicenceAddress avsPersonPersonCards
|
||||
mbCompany = firmAddress ^? _Just . _1 . _Just
|
||||
userFirmAddr= plaintextToStoredMarkup . mergeCompanyAddress <$> firmAddress
|
||||
let (mbCompany, mbCoFirmAddr, _) = guessLicenceAddress avsPersonPersonCards
|
||||
userFirmAddr= plaintextToStoredMarkup <$> mbCoFirmAddr
|
||||
pinCard = Set.lookupMax avsPersonPersonCards
|
||||
userPin = personCard2pin <$> pinCard
|
||||
fakeIdent = CI.mk $ "AVSID:" <> tshow api
|
||||
fakeNo = CI.mk $ "AVSNO:" <> tshow avsPersonPersonNo
|
||||
newUsr = AddUserData
|
||||
{ audTitle = Nothing
|
||||
, audFirstName = avsFirstName
|
||||
, audSurname = avsSurname
|
||||
, audDisplayName = avsFirstName <> Text.cons ' ' avsSurname
|
||||
, audDisplayEmail = "" -- Email is unknown in this version of the avs query, to be updated later (FUTURE TODO)
|
||||
, audMatriculation = Nothing
|
||||
, audSex = Nothing
|
||||
, audBirthday = Nothing
|
||||
, audMobile = Nothing
|
||||
, audTelephone = Nothing
|
||||
, audFPersonalNumber = avsInternalPersonalNo <$> canonical avsPersonInternalPersonalNo
|
||||
, audFDepartment = Nothing
|
||||
, audPostAddress = userFirmAddr
|
||||
, audPrefersPostal = True
|
||||
, audPinPassword = userPin
|
||||
{ audTitle = Nothing
|
||||
, audFirstName = avsFirstName
|
||||
, audSurname = avsSurname
|
||||
, audDisplayName = avsFirstName <> Text.cons ' ' avsSurname
|
||||
, audDisplayEmail = "" -- Email is unknown in this version of the avs query, to be updated later (FUTURE TODO)
|
||||
, audMatriculation = Nothing
|
||||
, audSex = Nothing
|
||||
, audBirthday = Nothing
|
||||
, audMobile = Nothing
|
||||
, audTelephone = Nothing
|
||||
, audFPersonalNumber = avsInternalPersonalNo <$> canonical avsPersonInternalPersonalNo
|
||||
, audFDepartment = Nothing
|
||||
, audPostAddress = userFirmAddr
|
||||
, audPrefersPostal = True
|
||||
, audPinPassword = userPin
|
||||
, audEmail = fakeNo -- Email is unknown in this version of the avs query, to be updated later (FUTURE TODO)
|
||||
, audIdent = fakeIdent -- use AvsPersonId instead
|
||||
, audAuth = maybe AuthKindNoLogin (const AuthKindLDAP) avsPersonInternalPersonalNo -- FUTURE TODO: if email is known, use AuthKinfPWHash for email invite, if no internal personnel number is known
|
||||
@ -424,24 +423,22 @@ upsertAvsUserById api = do
|
||||
whenIsJust mbUid $ \uid -> runDB $ do
|
||||
now <- liftIO getCurrentTime
|
||||
insert_ $ UserAvs avsPersonPersonID uid avsPersonPersonNo
|
||||
forM_ avsPersonPersonCards $ -- save all cards for later
|
||||
forM_ avsPersonPersonCards $ -- save all cards for later comparisons whether an update occurred
|
||||
-- let cs :: Set AvsDataPersonCard = Set.fromList $ catMaybes [pinCard, addrCard]
|
||||
-- forM_ cs $ -- only save used cards for the postal address update detection
|
||||
\avsCard -> insert_ $ UserAvsCard avsPersonPersonID (getFullCardNo avsCard) avsCard now
|
||||
upsertUserCompany uid mbCompany
|
||||
upsertUserCompany uid mbCompany userFirmAddr
|
||||
return mbUid
|
||||
|
||||
(Just (Entity _ UserAvs{userAvsUser=uid}), Just AvsDataPerson{avsPersonPersonCards}) -> do -- known user, update address and pinPassword
|
||||
let firmAddress = guessLicenceAddress avsPersonPersonCards
|
||||
mbCompany = firmAddress ^? _Just . _1 . _Just
|
||||
mbCoFirmAddr= mergeCompanyAddress <$> firmAddress
|
||||
let (mbCompany, mbCoFirmAddr, _) = guessLicenceAddress avsPersonPersonCards
|
||||
userFirmAddr= plaintextToStoredMarkup <$> mbCoFirmAddr
|
||||
pinCard = Set.lookupMax avsPersonPersonCards
|
||||
userPin = personCard2pin <$> pinCard
|
||||
userPin = personCard2pin <$> pinCard
|
||||
runDB $ do
|
||||
now <- liftIO getCurrentTime
|
||||
oldCards <- selectList [UserAvsCardPersonId ==. api] []
|
||||
let oldAddrs = Set.fromList $ mapMaybe (maybeCompanyAddress . userAvsCardCard . entityVal) oldCards
|
||||
let oldAddrs = Set.fromList $ mapMaybe (snd3 . getCompanyAddress . userAvsCardCard . entityVal) oldCards
|
||||
unless (maybe True (`Set.member` oldAddrs) mbCoFirmAddr) $ do -- update postal address, unless the exact address had been seen before
|
||||
encRecipient :: CryptoUUIDUser <- encrypt uid
|
||||
$logInfoS "AVS" $ "Postal address updated for" <> tshow encRecipient
|
||||
@ -452,7 +449,7 @@ upsertAvsUserById api = do
|
||||
updateWhere [UserId ==. uid, UserPinPassword !=. userPin, UserPinPassword <-. Nothing:oldPins]
|
||||
[UserPinPassword =. userPin]
|
||||
insert_ $ UserAvsCard api (getFullCardNo pCard) pCard now
|
||||
upsertUserCompany uid mbCompany
|
||||
upsertUserCompany uid mbCompany userFirmAddr
|
||||
forM_ avsPersonPersonCards $ \aCard -> void $ upsert UserAvsCard
|
||||
{ userAvsCardPersonId = api
|
||||
, userAvsCardCardNo = getFullCardNo aCard
|
||||
|
||||
@ -15,9 +15,9 @@ import qualified Data.Text as Text
|
||||
import Database.Persist.Postgresql
|
||||
|
||||
-- | Ensure that the given user is linked to the given company
|
||||
upsertUserCompany :: UserId -> Maybe Text -> DB ()
|
||||
upsertUserCompany uid (Just cName) | notNull cName = do
|
||||
cid <- upsertCompany cName
|
||||
upsertUserCompany :: UserId -> Maybe Text -> Maybe StoredMarkup -> DB ()
|
||||
upsertUserCompany uid (Just cName) cAddr | notNull cName = do
|
||||
cid <- upsertCompany cName cAddr
|
||||
void $ upsertBy (UniqueUserCompany uid cid)
|
||||
(UserCompany uid cid False False)
|
||||
[]
|
||||
@ -25,12 +25,13 @@ upsertUserCompany uid (Just cName) | notNull cName = do
|
||||
upsertManyWhere [ UserSupervisor super uid reroute
|
||||
| Entity{entityVal=UserCompany{userCompanyUser=super, userCompanySupervisorReroute=reroute, userCompanySupervisor=True}} <- superVs
|
||||
] [] [] []
|
||||
upsertUserCompany uid _ =
|
||||
upsertUserCompany uid _ _ =
|
||||
deleteWhere [ UserCompanyUser ==. uid ] -- maybe also delete company supervisors?
|
||||
|
||||
|
||||
upsertCompany :: Text -> DB CompanyId
|
||||
upsertCompany cName =
|
||||
-- | Does not update company address for now
|
||||
-- TODO: update company address, maybe?!
|
||||
upsertCompany :: Text -> Maybe StoredMarkup -> DB CompanyId
|
||||
upsertCompany cName cAddr =
|
||||
let cName' = CI.mk cName in
|
||||
getBy (UniqueCompanyName cName') >>= \case
|
||||
Just ent -> return $ entityKey ent
|
||||
@ -39,7 +40,7 @@ upsertCompany cName =
|
||||
Nothing -> do
|
||||
let cShort = companyShorthandFromName cName
|
||||
cShort' <- findShort cName' $ CI.mk cShort
|
||||
let compy = Company cName' cShort' 0 False Nothing -- TODO
|
||||
let compy = Company cName' cShort' 0 False cAddr -- TODO: Fix this once AVS CR3 SCF-165 is implemented
|
||||
either entityKey id <$> insertBy compy
|
||||
where
|
||||
findShort :: CompanyName -> CompanyShorthand -> DB CompanyShorthand
|
||||
|
||||
@ -101,30 +101,23 @@ getValidLicence cutoff licence' cards = Set.lookupMax validLicenceCards
|
||||
avsDataValid && (avsDataValidTo >= cutoff) && (licence `Set.member` avsDataCardAreas)
|
||||
|
||||
|
||||
getCompanyAddress :: AvsDataPersonCard -> Maybe (Maybe Text, Text, AvsDataPersonCard)
|
||||
getCompanyAddress :: AvsDataPersonCard -> (Maybe Text, Maybe Text, Maybe AvsDataPersonCard)
|
||||
getCompanyAddress card@AvsDataPersonCard{..}
|
||||
| Just street <- avsDataStreet
|
||||
, Just pcode <- avsDataPostalCode
|
||||
, Just city <- avsDataCity
|
||||
= Just (avsDataFirm, Text.unlines [street, Text.unwords [pcode, city]], card)
|
||||
| otherwise = Nothing
|
||||
= (avsDataFirm, Just $ Text.unlines $ mcons avsDataFirm [street, Text.unwords [pcode, city]], Just card)
|
||||
| isJust avsDataFirm = (avsDataFirm, Nothing, Just card)
|
||||
| otherwise = (Nothing, Nothing, Nothing)
|
||||
|
||||
-- | From a set of card, choose the one with the most complete postal address.
|
||||
-- Returns company, postal address and the associated card where the address was taken from
|
||||
guessLicenceAddress :: Set AvsDataPersonCard -> Maybe (Maybe Text, Text, AvsDataPersonCard)
|
||||
guessLicenceAddress :: Set AvsDataPersonCard -> (Maybe Text, Maybe Text, Maybe AvsDataPersonCard)
|
||||
guessLicenceAddress cards
|
||||
| Just c <- Set.lookupMax cards
|
||||
, card <- Set.foldr pickLicenceAddress c cards
|
||||
= getCompanyAddress card
|
||||
| otherwise = Nothing
|
||||
|
||||
-- | Helper for guessLicenceAddress or getCompanyAddress
|
||||
mergeCompanyAddress :: (Maybe Text, Text, a) -> Text
|
||||
mergeCompanyAddress (Nothing , addr, _) = addr
|
||||
mergeCompanyAddress (Just firm, addr, _) = firm <> Text.cons '\n' addr
|
||||
|
||||
maybeCompanyAddress :: AvsDataPersonCard -> Maybe Text
|
||||
maybeCompanyAddress = fmap mergeCompanyAddress . getCompanyAddress
|
||||
| otherwise = (Nothing, Nothing, Nothing)
|
||||
|
||||
hasAddress :: AvsDataPersonCard -> Bool
|
||||
hasAddress AvsDataPersonCard{..} = isJust avsDataStreet && isJust avsDataCity && isJust avsDataPostalCode
|
||||
|
||||
Loading…
Reference in New Issue
Block a user