fix(avs): repeated avs sync enqueue no longe violates duplicate db uniqueness constraints
This commit is contained in:
parent
da74b95729
commit
996e6a0ce5
@ -95,7 +95,7 @@ handleAdminProblems mbProblemTable = do
|
||||
(Left e) -> return $ Left $ text2widget $ tshow (e :: SomeException)
|
||||
(Right AvsLicenceDifferences{..}) -> do
|
||||
let problemIds = avsLicenceDiffRevokeAll <> avsLicenceDiffGrantVorfeld <> avsLicenceDiffRevokeRollfeld <> avsLicenceDiffGrantRollfeld
|
||||
queueAvsUpdateByAID problemIds $ Just nowaday
|
||||
void $ runDB $ queueAvsUpdateByAID problemIds $ Just nowaday
|
||||
return $ Right
|
||||
( Set.size avsLicenceDiffRevokeAll
|
||||
, Set.size avsLicenceDiffGrantVorfeld
|
||||
|
||||
@ -1270,6 +1270,6 @@ getAdminUserSyncLdapR uuid = do
|
||||
getAdminUserSyncAvsR :: CryptoUUIDUser -> Handler Html
|
||||
getAdminUserSyncAvsR uuid = do
|
||||
uid <- decrypt uuid
|
||||
queueAvsUpdateByUID (Set.singleton uid) Nothing
|
||||
addMessageI Success $ MsgSynchroniseAvsUserQueued 1
|
||||
n <- runDB $ queueAvsUpdateByUID (Set.singleton uid) Nothing
|
||||
addMessageI Success $ MsgSynchroniseAvsUserQueued $ fromIntegral n
|
||||
redirectUltDest $ AdminUserR uuid
|
||||
|
||||
@ -62,19 +62,20 @@ hijackUserForm = \csrf -> do
|
||||
-- instance HasUser (DBRow (Entity USer)) where
|
||||
-- hasUser = _entityVal
|
||||
|
||||
data UserAction = UserLdapSync | UserAddSupervisor | UserSetSupervisor | UserRemoveSupervisor | UserAvsSync
|
||||
data UserAction = UserAvsSync | UserLdapSync | UserAddSupervisor | UserSetSupervisor | UserRemoveSupervisor
|
||||
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
|
||||
deriving anyclass (Universe, Finite)
|
||||
|
||||
nullaryPathPiece ''UserAction $ camelToPathPiece' 1
|
||||
embedRenderMessage ''UniWorX ''UserAction id
|
||||
|
||||
data UserActionData = UserLdapSyncData
|
||||
data UserActionData = UserAvsSyncData
|
||||
| UserLdapSyncData
|
||||
| UserHijack
|
||||
| UserAddSupervisorData { getActionSupervisors :: Set Text, getActionRerouteNotifications :: Bool, getActionSupervisorReason :: Maybe Text }
|
||||
| UserSetSupervisorData { getActionSupervisors :: Set Text, getActionRerouteNotifications :: Bool, getActionSupervisorReason :: Maybe Text }
|
||||
| UserRemoveSupervisorData
|
||||
| UserAvsSyncData
|
||||
|
||||
deriving (Eq, Ord, Read, Show, Generic)
|
||||
|
||||
isNotSetSupervisor :: UserActionData -> Bool
|
||||
@ -369,8 +370,8 @@ postUsersR = do
|
||||
addMessageI Success . MsgSynchroniseLdapUserQueued $ Set.size userSet
|
||||
redirectKeepGetParams UsersR
|
||||
(UserAvsSyncData, userSet) -> do
|
||||
queueAvsUpdateByUID userSet Nothing
|
||||
addMessageI Success . MsgSynchroniseAvsUserQueued $ Set.size userSet
|
||||
n <- runDB $ queueAvsUpdateByUID userSet Nothing
|
||||
addMessageI Success . MsgSynchroniseAvsUserQueued $ fromIntegral n
|
||||
redirectKeepGetParams UsersR
|
||||
(UserHijack, Set.lookupMin -> Just uid) ->
|
||||
hijackUser uid >>= sendResponse
|
||||
@ -404,16 +405,23 @@ postUsersR = do
|
||||
runDBJobs . runConduit $ selectSource [] [] .| C.mapM_ (queueDBJob . JobSynchroniseLdapUser . entityKey)
|
||||
addMessageI Success MsgSynchroniseLdapAllUsersQueued
|
||||
redirect UsersR
|
||||
AllUsersAvsSync -> do
|
||||
nowaday <- liftIO getCurrentTime <&> utctDay
|
||||
n <- runDB $ Ex.insertSelectCount $ do
|
||||
usr <- Ex.from $ Ex.table @User
|
||||
return (AvsSync
|
||||
Ex.<# (usr Ex.^. UserId)
|
||||
Ex.<&> E.now_
|
||||
-- Ex.<&> Ex.just (E.day E.now_) -- don't use DB time here, since job handler compares with FRADrive clock
|
||||
Ex.<&> E.justVal nowaday
|
||||
)
|
||||
AllUsersAvsSync -> do
|
||||
now <- liftIO getCurrentTime
|
||||
let nowaday = utctDay now
|
||||
n <- runDB $ E.insertSelectWithConflictCount UniqueAvsSyncUser
|
||||
( do
|
||||
usr <- Ex.from $ Ex.table @User
|
||||
return (AvsSync
|
||||
Ex.<# (usr Ex.^. UserId)
|
||||
Ex.<&> E.val now
|
||||
-- Ex.<&> Ex.just (E.day E.now_) -- don't use DB time here, since job handler compares with FRADrive clock
|
||||
Ex.<&> E.justVal nowaday
|
||||
)
|
||||
) (\current excluded ->
|
||||
[ AvsSyncCreationTime E.=. E.least (current E.^. AvsSyncCreationTime) (excluded E.^. AvsSyncCreationTime)
|
||||
, AvsSyncPause E.=. E.greatest (current E.^. AvsSyncPause) (excluded E.^. AvsSyncPause)
|
||||
]
|
||||
)
|
||||
queueJob' JobSynchroniseAvsQueue
|
||||
addMessageI Success $ MsgSynchroniseAvsAllUsersQueued n
|
||||
redirect UsersR
|
||||
|
||||
@ -61,7 +61,7 @@ import Handler.Utils.Memcached
|
||||
import Database.Esqueleto.Experimental ((:&)(..))
|
||||
import qualified Database.Esqueleto.Experimental as E -- needs TypeApplications Lang-Pragma
|
||||
import qualified Database.Esqueleto.Utils as E
|
||||
-- import qualified Database.Esqueleto.PostgreSQL as E
|
||||
import qualified Database.Esqueleto.PostgreSQL as E
|
||||
|
||||
import Servant.Client.Core.ClientError (ClientError)
|
||||
|
||||
@ -648,24 +648,28 @@ upsertAvsCompany newAvsFirmInfo mbOldAvsFirmInfo = do
|
||||
]
|
||||
|
||||
|
||||
queueAvsUpdateByUID :: (MonoFoldable mono, UserId ~ Element mono) => mono -> Maybe Day -> DB Int64
|
||||
queueAvsUpdateByUID uids = queueAvsUpdateAux (E.table @User) (E.^. UserId) (\usr -> usr E.^. UserId `E.in_` E.vals uids)
|
||||
|
||||
queueAvsUpdateByUID :: (MonoFoldable mono, UserId ~ Element mono) => mono -> Maybe Day -> Handler ()
|
||||
queueAvsUpdateByUID uids pause = do
|
||||
now <- liftIO getCurrentTime
|
||||
runDB $ putMany [AvsSync uid now pause | uid <- toList uids]
|
||||
queueJob' JobSynchroniseAvsQueue
|
||||
queueAvsUpdateByAID :: (MonoFoldable mono, AvsPersonId ~ Element mono) => mono -> Maybe Day -> DB Int64
|
||||
queueAvsUpdateByAID aids = queueAvsUpdateAux (E.table @UserAvs) (E.^. UserAvsUser) (\usrAvs -> usrAvs E.^. UserAvsPersonId `E.in_` E.vals aids)
|
||||
|
||||
queueAvsUpdateByAID :: (MonoFoldable mono, AvsPersonId ~ Element mono) => mono -> Maybe Day -> Handler ()
|
||||
queueAvsUpdateByAID aids pause = do
|
||||
now <- liftIO getCurrentTime
|
||||
runDB $ do
|
||||
uids <- E.select $ do
|
||||
usrAvs <- E.from $ E.table @UserAvs
|
||||
E.where_ $ usrAvs E.^. UserAvsPersonId `E.in_` E.vals aids
|
||||
-- E.&&. (E.isNothing pause E.||. pause E.>. E.dayMaybe (usrAvs E.?. UserAvsLastSynch)) -- pause is checked later on in JobSynchroniseAvsQueue
|
||||
return $ usrAvs E.^. UserAvsUser
|
||||
putMany [AvsSync uid now pause | E.Value uid <- uids]
|
||||
queueJob' JobSynchroniseAvsQueue
|
||||
-- queueAvsUpdateAux :: E.From (E.SqlExpr (Entity ent)) -> (E.SqlExpr (Entity ent) -> E.SqlExpr (E.Value UserId)) -> (E.SqlExpr (Entity ent) -> E.SqlExpr (E.Value Bool)) -> Maybe Day -> DB Int64
|
||||
queueAvsUpdateAux :: E.From t -> (t -> E.SqlExpr (E.Value UserId)) -> (t -> E.SqlExpr (E.Value Bool)) -> Maybe Day -> DB Int64
|
||||
queueAvsUpdateAux tbl prj fltr pause = do
|
||||
now <- liftIO getCurrentTime
|
||||
n <- E.insertSelectWithConflictCount UniqueAvsSyncUser
|
||||
( do
|
||||
usr <- E.from tbl
|
||||
E.where_ $ fltr usr
|
||||
return (AvsSync E.<# prj usr E.<&> E.val now E.<&> E.val pause)
|
||||
) (\current excluded ->
|
||||
[ AvsSyncCreationTime E.=. E.least (current E.^. AvsSyncCreationTime) (excluded E.^. AvsSyncCreationTime)
|
||||
, AvsSyncPause E.=. E.greatest (current E.^. AvsSyncPause) (excluded E.^. AvsSyncPause)
|
||||
]
|
||||
)
|
||||
runDBJobs' $ queueDBJob JobSynchroniseAvsQueue
|
||||
return n
|
||||
|
||||
|
||||
-- | Find or upsert User by AvsCardId (with dot), Fraport PersonalNumber, Fraport Email-Address or by prefixed AvsId or prefixed AvsNo;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user