From c3b6d186c4ed3cd22a746956bbaf09935a699fa3 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Mon, 13 Feb 2023 17:39:59 +0100 Subject: [PATCH] chore(avs): allow companies without postal address --- models/avs.model | 1 + src/Handler/Utils/Avs.hs | 49 +++++++++++++++++------------------- src/Handler/Utils/Company.hs | 17 +++++++------ src/Utils/Avs.hs | 19 +++++--------- 4 files changed, 39 insertions(+), 47 deletions(-) diff --git a/models/avs.model b/models/avs.model index 371a3dae0..45f2321d7 100644 --- a/models/avs.model +++ b/models/avs.model @@ -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 diff --git a/src/Handler/Utils/Avs.hs b/src/Handler/Utils/Avs.hs index 177dabfa2..db27e663b 100644 --- a/src/Handler/Utils/Avs.hs +++ b/src/Handler/Utils/Avs.hs @@ -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 diff --git a/src/Handler/Utils/Company.hs b/src/Handler/Utils/Company.hs index 74990a803..1b8b9dafa 100644 --- a/src/Handler/Utils/Company.hs +++ b/src/Handler/Utils/Company.hs @@ -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 diff --git a/src/Utils/Avs.hs b/src/Utils/Avs.hs index 78a1183b8..560aa49ad 100644 --- a/src/Utils/Avs.hs +++ b/src/Utils/Avs.hs @@ -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