From 7a5917131c9a2f742beb663db3b96ca8d872777b Mon Sep 17 00:00:00 2001 From: Steffen Date: Thu, 21 Mar 2024 16:55:23 +0100 Subject: [PATCH] chore(avs): WIP properly update userCompany upon AVS change --- config/settings.yml | 2 +- src/Handler/Utils/Avs.hs | 28 +++++++++++++++++++++------- src/Handler/Utils/Company.hs | 4 +--- src/Handler/Utils/Users.hs | 3 +-- src/Utils.hs | 3 ++- src/Utils/DB.hs | 18 ++++++++++++++++++ 6 files changed, 44 insertions(+), 14 deletions(-) diff --git a/config/settings.yml b/config/settings.yml index b3b61a502..bbe83979c 100644 --- a/config/settings.yml +++ b/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" diff --git a/src/Handler/Utils/Avs.hs b/src/Handler/Utils/Avs.hs index 4d12acf70..530ddfe22 100644 --- a/src/Handler/Utils/Avs.hs +++ b/src/Handler/Utils/Avs.hs @@ -519,20 +519,34 @@ 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 -> return usr_up0 -- => do nothing (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) - (UserCompany usrId newCompanyId False False 1 True) - [UserCompanyCompany =. newCompanyId] - whenIsJust oldCompanyId $ \ocid -> - updateWhere [UserSupervisorSupervisor ==. usrId, UserSupervisorCompany ==. Just ocid, UserSupervisorReason ==. Just superReasonComDef] - [UserSupervisorCompany =. Just newCompanyId] + -- newUC <- getBy (UniqueUserCompany usrId oldCompanyId) >>= \case + -- Nothing -> return $ UserCompany usrId newCompanyId False False 1 True + -- Just Entity{entityVal=oldUCid, entityVal=oldUC} -> do + -- delete oldUCid + -- return $ oldUC & _userCompanyCompany .~ 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 diff --git a/src/Handler/Utils/Company.hs b/src/Handler/Utils/Company.hs index e396bb093..7e8a9aa80 100644 --- a/src/Handler/Utils/Company.hs +++ b/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) - (UserCompany uid cid False False 0 False) - [] + void $ insertUnique $ UserCompany uid cid False False 1 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 diff --git a/src/Handler/Utils/Users.hs b/src/Handler/Utils/Users.hs index 7e101eba2..6c1f11dbf 100644 --- a/src/Handler/Utils/Users.hs +++ b/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 $ upsertBy (UniqueUserAvsId (oldUserAvs ^. _userAvsPersonId)) oldUserAvs{userAvsUser=newUserId} [UserAvsUser =. newUserId] + -> void $ upsertBySafe (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) diff --git a/src/Utils.hs b/src/Utils.hs index ce5f00f0e..1ce464ec1 100644 --- a/src/Utils.hs +++ b/src/Utils.hs @@ -11,7 +11,7 @@ import ClassyPrelude.Yesod hiding (foldlM, Proxy, handle, catch, bracket) -- import Data.Double.Conversion.Text -- faster implementation for textPercent? import qualified Data.Foldable as Fold -import qualified Data.Traversable as Trav +import qualified Data.Traversable as Trav import Data.Foldable as Utils (foldlM, foldrM) import Data.Monoid (First, Sum(..), Endo) import Data.Proxy @@ -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 diff --git a/src/Utils/DB.hs b/src/Utils/DB.hs index 73f12b8a7..db94effe3 100644 --- a/src/Utils/DB.hs +++ b/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