refactor(avs): update letter-pin and postal address if unseen before

src/Handler/Utils/Avs.hs

@@ -300,7 +300,6 @@ upsertAvsUserById api = do
       let firmAddress = guessLicenceAddress avsPersonPersonCards
           mbCompany   = firmAddress ^? _Just . _1 . _Just
           userFirmAddr= plaintextToStoredMarkup . mergeCompanyAddress <$> firmAddress          
-          addrCard    = firmAddress ^? _Just . _3 
           pinCard     = Set.lookupMax avsPersonPersonCards
           userPin     = tshowAvsFullCardNo . getFullCardNo <$> pinCard          
           fakeIdent   = CI.mk $ "AVSID:" <> tshow api
@@ -328,9 +327,9 @@ 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
-        let cs :: Set AvsDataPersonCard = Set.fromList $ catMaybes [pinCard, addrCard]
+        -- let cs :: Set AvsDataPersonCard = Set.fromList $ catMaybes [pinCard, addrCard]
-        forM_ cs $  -- only save used cards for the postal address update detection
+        -- forM_ cs $  -- only save used cards for the postal address update detection
             \avsCard -> insert_ $ UserAvsCard avsPersonPersonID (avsDataCardNo avsCard) avsCard now 
         upsertUserCompany uid mbCompany                    
       return mbUid
@@ -338,36 +337,32 @@ upsertAvsUserById api = do
     (Just (Entity _ UserAvs{userAvsUser=uid}), Just AvsDataPerson{avsPersonPersonCards}) -> do -- known user, update address and pinPassword
       let firmAddress = guessLicenceAddress avsPersonPersonCards
           mbCompany   = firmAddress ^? _Just . _1 . _Just
-          userFirmAddr= plaintextToStoredMarkup . mergeCompanyAddress <$> firmAddress
+          mbCoFirmAddr= mergeCompanyAddress <$> firmAddress
-          addrCard    = firmAddress ^? _Just . _3 
+          userFirmAddr= plaintextToStoredMarkup <$> mbCoFirmAddr          
           pinCard     = Set.lookupMax avsPersonPersonCards
           userPin     = tshowAvsFullCardNo . getFullCardNo <$> pinCard          
       runDB $ do 
         now <- liftIO getCurrentTime        
-        upsertUserCompany uid mbCompany
+        oldCards <- selectList [UserAvsCardPersonId ==. api] []
-        whenIsJust addrCard $ \aCard ->
+        let oldAddrs = Set.fromList $ mapMaybe (maybeCompanyAddress . userAvsCardCard . entityVal) oldCards
-          getBy (UniqueAvsCard $ avsDataCardNo aCard) >>= \case
+        unless (maybe True (`Set.member` oldAddrs) mbCoFirmAddr) $ do  -- update postal address, unless the exact address had been seen before
-            (Just (Entity uac UserAvsCard{..})) | aCard == userAvsCardCard -> -- address seen before, no change
+          updateWhere [UserId ==. uid] [UserPostAddress =. userFirmAddr]
-              update uac [UserAvsCardLastSynch =. now]
+        whenIsJust pinCard $ \pCard -> -- update pin, but only if it was unset or set to the value of an old card
-            _ -> do -- possibly new address data 
-              void $ upsert UserAvsCard
-                      { userAvsCardPersonId = api
-                      , userAvsCardCardNo   = avsDataCardNo aCard
-                      , userAvsCardCard     = aCard
-                      , userAvsCardLastSynch= now
-                      }
-                      [ UserAvsCardCard      =. aCard
-                      , UserAvsCardLastSynch =. now
-                      ]            
-              when (isJust userFirmAddr) $ updateWhere [UserId ==. uid] [UserPostAddress =. userFirmAddr]
-        whenIsJust pinCard $ \pCard -> 
           unlessM (exists [UserAvsCardCardNo ==. avsDataCardNo pCard]) $ do                         
-            -- update pin, but only if it was unset or set to the value of an old card
-            oldCards <- selectList [UserAvsCardPersonId ==. api] []
             let oldPins = Just . tshowAvsFullCardNo . getFullCardNo . userAvsCardCard . entityVal <$> oldCards
             updateWhere [UserId ==. uid, UserPinPassword !=. userPin, UserPinPassword <-. Nothing:oldPins]
                         [UserPinPassword =. userPin]
             insert_ $ UserAvsCard api (avsDataCardNo pCard) pCard now
+        upsertUserCompany uid mbCompany
+        forM_ avsPersonPersonCards $ \aCard -> void $ upsert UserAvsCard
+            { userAvsCardPersonId  = api
+            , userAvsCardCardNo    = avsDataCardNo aCard
+            , userAvsCardCard      = aCard
+            , userAvsCardLastSynch = now
+            }
+            [ UserAvsCardCard      =. aCard
+            , UserAvsCardLastSynch =. now
+            ]                                  
       return $ Just uid
 
 

src/Model/Types/Avs.hs

@@ -150,6 +150,11 @@ instance ToJSON AvsCardNo where
 normalizeAvsCardNo :: Text -> Text
 normalizeAvsCardNo = Text.justifyRight 8 '0'
 
+instance Canonical AvsCardNo where 
+  canonical AvsCardNo{..} = AvsCardNo $ normalizeAvsCardNo avsCardNo
+  -- canonical = AvsCardNo . normalizeAvsCardNo . avsCardNo
+
+
 data AvsFullCardNo = AvsFullCardNo { avsFullCardNo :: AvsCardNo, avsFullCardVersion :: AvsVersionNo }
   deriving (Eq, Ord, Generic, Typeable)
 
@@ -319,6 +324,7 @@ instance Canonical AvsDataPersonCard where
           & _avsDataPostalCode  %~ canonical
           & _avsDataCity        %~ canonical
           & _avsDataFirm        %~ canonical
+          & _avsDataCardNo      %~ canonical
 
 -- TODO: use canonical in FromJSON/ToJSON instances for consistency
 instance FromJSON AvsDataPersonCard where
@@ -332,7 +338,7 @@ instance FromJSON AvsDataPersonCard where
     <*> v .:?! "PostalCode"
     <*> v .:?! "City"
     <*> v .:?! "Firm"
-    <*> v .: "CardNo"
+    <*> ((v .: "CardNo") <&> canonical)
     <*> v .: "VersionNo"
 
 instance ToJSON AvsDataPersonCard where
@@ -349,7 +355,7 @@ instance ToJSON AvsDataPersonCard where
     [ "Valid"       .= show avsDataValid
     , "CardColor"   .= avsDataCardColor
     , "CardAreas"   .= Set.foldl Text.snoc Text.empty avsDataCardAreas
-    , "CardNo"      .= avsDataCardNo
+    , "CardNo"      .= (avsDataCardNo & canonical)
     , "VersionNo"   .= avsDataVersionNo
     ]
 derivePersistFieldJSON ''AvsDataPersonCard

src/Utils/Avs.hs

@@ -89,21 +89,32 @@ getValidLicence cutoff licence' cards = Set.lookupMax validLicenceCards
     cardMatch AvsDataPersonCard{..} =
       avsDataValid && (avsDataValidTo >= cutoff) && (licence `Set.member` avsDataCardAreas)
 
-guessLicenceAddress :: Set AvsDataPersonCard -> Maybe (Maybe Text, Text, AvsDataPersonCard)
+
-guessLicenceAddress cards
+getCompanyAddress :: AvsDataPersonCard -> Maybe (Maybe Text, Text, AvsDataPersonCard)
-  | Just c <- Set.lookupMax cards
+getCompanyAddress card@AvsDataPersonCard{..} 
-  , card@AvsDataPersonCard{..} <- Set.foldr pickLicenceAddress c cards
+  | Just street <- avsDataStreet
-  , Just street <- avsDataStreet
   , Just pcode  <- avsDataPostalCode
   , Just city   <- avsDataCity
     = Just (avsDataFirm, Text.unlines [street, Text.unwords [pcode, city]], card)
   | otherwise = Nothing
 
--- | Helper for guessLicenceAddress
+-- | 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 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
+
 hasAddress :: AvsDataPersonCard -> Bool
 hasAddress AvsDataPersonCard{..} = isJust avsDataStreet && isJust avsDataCity && isJust avsDataPostalCode
 

templates/admin-problems.hamlet

@@ -40,4 +40,4 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
     <dd .deflist__dd>^{simpleLinkI MsgProblemsUsersAreReachable ProblemUnreachableR}
 
     <dt .deflist__dt>^{flagError noStalePrintJobs}
-    <dd .deflist__dd>^{simpleLink (i18n (MsgProblemsNoStalePrintJobs cutOffPrintDays)) PrintCenterR}
+    <dd .deflist__dd>^{simpleLinkI (MsgProblemsNoStalePrintJobs cutOffPrintDays) PrintCenterR}