chore(avs): allow companies without postal address

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  

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
+      let (mbCompany, mbCoFirmAddr, _) = guessLicenceAddress avsPersonPersonCards
-          mbCompany   = firmAddress ^? _Just . _1 . _Just
+          userFirmAddr= plaintextToStoredMarkup <$> mbCoFirmAddr
-          userFirmAddr= plaintextToStoredMarkup . mergeCompanyAddress <$> firmAddress
           pinCard     = Set.lookupMax avsPersonPersonCards
           userPin     = personCard2pin <$> pinCard
           fakeIdent   = CI.mk $ "AVSID:" <> tshow api
           fakeNo      = CI.mk $ "AVSNO:" <> tshow avsPersonPersonNo          
           newUsr = AddUserData
-            { audTitle          = Nothing
+            { audTitle            = Nothing
-            , audFirstName      = avsFirstName
+            , audFirstName        = avsFirstName
-            , audSurname        = avsSurname
+            , audSurname          = avsSurname
-            , audDisplayName    = avsFirstName <> Text.cons ' ' avsSurname
+            , audDisplayName      = avsFirstName <> Text.cons ' ' avsSurname
-            , audDisplayEmail   = "" -- Email is unknown in this version of the avs query, to be updated later (FUTURE TODO)
+            , audDisplayEmail     = "" -- Email is unknown in this version of the avs query, to be updated later (FUTURE TODO)
-            , audMatriculation  = Nothing
+            , audMatriculation    = Nothing
-            , audSex            = Nothing
+            , audSex              = Nothing
-            , audBirthday       = Nothing
+            , audBirthday         = Nothing
-            , audMobile         = Nothing
+            , audMobile           = Nothing
-            , audTelephone      = Nothing
+            , audTelephone        = Nothing
-            , audFPersonalNumber = avsInternalPersonalNo <$> canonical avsPersonInternalPersonalNo
+            , audFPersonalNumber  = avsInternalPersonalNo <$> canonical avsPersonInternalPersonalNo
-            , audFDepartment    = Nothing
+            , audFDepartment      = Nothing
-            , audPostAddress    = userFirmAddr
+            , audPostAddress      = userFirmAddr
-            , audPrefersPostal  = True
+            , audPrefersPostal    = True
-            , audPinPassword    = userPin
+            , 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
+      let (mbCompany, mbCoFirmAddr, _) = guessLicenceAddress avsPersonPersonCards          
-          mbCompany   = firmAddress ^? _Just . _1 . _Just
-          mbCoFirmAddr= mergeCompanyAddress <$> firmAddress
           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

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 :: UserId -> Maybe Text -> Maybe StoredMarkup -> DB ()
-upsertUserCompany uid (Just cName) | notNull cName = do 
+upsertUserCompany uid (Just cName) cAddr | notNull cName = do 
-  cid <- upsertCompany cName
+  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?
 
-
+-- | Does not update company address for now
-upsertCompany :: Text -> DB CompanyId
+-- TODO: update company address, maybe?!
-upsertCompany cName = 
+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    

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)
+    = (avsDataFirm, Just $ Text.unlines $ mcons avsDataFirm [street, Text.unwords [pcode, city]], Just card)
-  | otherwise = Nothing
+  | 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
+  | otherwise = (Nothing, Nothing, 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
 
 hasAddress :: AvsDataPersonCard -> Bool
 hasAddress AvsDataPersonCard{..} = isJust avsDataStreet && isJust avsDataCity && isJust avsDataPostalCode