chore(avs): WIP properly update userCompany upon AVS change

config/settings.yml

@@ -160,7 +160,7 @@ avs:
   host:         "_env:AVSHOST:skytest.fra.fraport.de"
   port:         "_env:AVSPORT:443"
   user:         "_env:AVSUSER:fradrive"
-  pass:         "_env:AVSPASS:"
+  pass:         "_env:AVSPASS:\"0000\""
   timeout:      "_env:AVSTIMEOUT:42"
   cache-expiry: "_env:AVSCACHEEXPIRY:420"
 

src/Handler/Utils/Avs.hs

@@ -519,6 +519,7 @@ updateAvsUserByIds apids = do
             oldCompanyMb = entityVal <$> oldCompanyEnt
             pst_up  = mkUpdate usr newCompany oldCompanyMb $ CheckAvsUpdate UserPrefersPostal _companyPrefersPostal  -- possibly change postal preference TODO: only if needed            
             superReasonComDef = tshow SupervisorReasonCompanyDefault
+        _primaryCompanyId <- getUserPrimaryCompany usrId (Just . CompanyKey . companyShorthand)
 
         usr_ups <- case oldAvsFirmInfo of 
           _ | oldCompanyId == Just newCompanyId                                               -- company unchanged entirely
@@ -526,13 +527,26 @@ updateAvsUserByIds apids = do
           (Just oafi) |  ((==) `on` view _avsFirmPostAddressSimple) oafi newAvsFirmInfo       -- company address unchanged OR
                       || ((==) `on` view _avsFirmPrimaryEmail)      oafi newAvsFirmInfo       -- company primary email unchanged
               -> do                                                                           --  => just update user company association, keeping supervision privileges
-                  void $ upsertBy (UniqueUserCompany usrId newCompanyId)                               
+                  -- newUC <- getBy (UniqueUserCompany usrId oldCompanyId) >>= \case
-                                  (UserCompany usrId newCompanyId False False 1 True) 
+                  --   Nothing -> return $ UserCompany usrId newCompanyId False False 1 True
-                                  [UserCompanyCompany =. newCompanyId]
+                  --   Just Entity{entityVal=oldUCid, entityVal=oldUC} -> do
-                  whenIsJust oldCompanyId $ \ocid ->
+                  --     delete oldUCid
-                    updateWhere [UserSupervisorSupervisor ==. usrId, UserSupervisorCompany ==. Just ocid, UserSupervisorReason ==. Just superReasonComDef] 
+                  --     return $ oldUC & _userCompanyCompany .~ newCompanyId
-                                [UserSupervisorCompany =. Just newCompanyId]
+                  -- void $ insertUnique newUC
+                  let newUserComp = UserCompany usrId newCompanyId False False 1 True
+                  case oldCompanyId of
+                    Nothing -> void $ insertUnique newUserComp -- it's ok if this already exists
+                    Just ocid -> do 
+                      void $ upsertBySafe (UniqueUserCompany usrId ocid) newUserComp (_userCompanyCompany .~ newCompanyId)                                  
+                      void $ updateWhere [ UserSupervisorSupervisor ==. usrId
+                                         , UserSupervisorCompany ==. Just ocid
+                                         , UserSupervisorReason ==. Just superReasonComDef] -- to we want this last condition?
+                                         [ UserSupervisorCompany =. Just newCompanyId]
                   return usr_up0
+          -- _ | newCompanyId == primaryCompanyId -- Wechsel der AVS-Firma zur FRADrive-Primärfirma
+            -- alte CompanyUser entfernen
+            -- keep Supervision unchanged
+            -- keep postal preference
           _                                                                                   -- company changed completely 
               -> do -- switch company
                   (getBy . UniqueUserCompany usrId) `traverseJoin` oldCompanyId >>= \case

src/Handler/Utils/Company.hs

@@ -18,9 +18,7 @@ import Database.Persist.Postgresql
 oldUpsertUserCompany :: UserId -> Maybe Text -> Maybe StoredMarkup -> DB () -- TODO: needs reworking
 oldUpsertUserCompany uid (Just cName) cAddr | notNull cName = do 
   cid <- oldUpsertCompany cName cAddr
-  void $ upsertBy (UniqueUserCompany uid cid) 
+  void $ insertUnique $ UserCompany uid cid False False 1 False
-                  (UserCompany uid cid False False 0 False) 
-                  []
   superVs <- selectList [UserCompanyCompany ==. cid, UserCompanySupervisor ==. True] []
   upsertManyWhere [ UserSupervisor super uid reroute (Just cid) Nothing
                   | Entity{entityVal=UserCompany{userCompanyUser=super, userCompanySupervisorReroute=reroute, userCompanySupervisor=True}} <- superVs

src/Handler/Utils/Users.hs

@@ -995,8 +995,7 @@ assimilateUser newUserId oldUserId = mapReaderT execWriterT $ do
     (Just Entity{entityVal=UserAvs{userAvsPersonId=oldAvsId}}, Just _) 
       -> deleteBy (UniqueUserAvsId oldAvsId)
     (Just Entity{entityVal=oldUserAvs}, Nothing) 
-      -> -- deleteBy $ UniqueUserAvsUser oldUserId -- maybe we need this due to double uniqueness?!
+      -> void $ upsertBySafe (UniqueUserAvsId (oldUserAvs ^. _userAvsPersonId)) oldUserAvs{userAvsUser=newUserId} (_userAvsUser .~ newUserId)
-         void $ upsertBy (UniqueUserAvsId (oldUserAvs ^. _userAvsPersonId)) oldUserAvs{userAvsUser=newUserId} [UserAvsUser =. newUserId]
 
   -- merge some optional / incomplete user fields
   let mergeBy :: forall a . PersistField a => (a -> a -> Bool) -> EntityField User a -> Maybe (Update User)

src/Utils.hs

@@ -932,6 +932,7 @@ whenIsJust :: Monad m => Maybe a -> (a -> m ()) -> m ()
 whenIsJust (Just x) f = f x
 whenIsJust Nothing  _ = return ()
 
+-- ifMaybeM m d a = maybe (return d) a m
 ifMaybeM :: Monad m => Maybe a -> b -> (a -> m b) -> m b -- more convenient argument order as compared to maybeM
 ifMaybeM Nothing dft _  = return dft
 ifMaybeM (Just x) _ act = act x

src/Utils/DB.hs

@@ -159,6 +159,24 @@ replaceEntity :: ( MonadIO m
               => Entity record -> ReaderT backend m ()
 replaceEntity Entity{..} = replace entityKey entityVal
 
+-- Notes on upsertBy:
+--  * Unique denotes old record
+--  * Changes to fields involved in uniqueness work, but may throw an error if updated record already exists
+
+-- | Safe version of upsertBy which does nothing if the new or updated record would violate a uniqueness constraint  
+upsertBySafe :: ( MonadIO m
+                , PersistEntity record
+                , PersistUniqueWrite backend
+                , PersistEntityBackend record ~ BaseBackend backend
+                ) 
+             => Unique record -> record -> (record -> record) -> ReaderT backend m (Maybe (Key record))
+upsertBySafe uniq newr upd = maybeM (insertUnique newr) do_upd (getBy uniq)
+  where 
+    do_upd Entity{entityKey = oid, entityVal = oldr} = do
+      delete oid
+      insertUnique $ upd oldr
+
+
 checkUniqueKeys :: ( MonadIO m
                    , PersistUniqueRead backend
                    , PersistRecordBackend record backend