fraport/fradrive-old
fraport/fradrive-old
Archived
3
1
Fork 0
Code Issues 65 Pull Requests 5 Actions Packages Projects Releases 197 Wiki Activity

fix(navigation): always link workflows nav to instances

Browse Source
This commit is contained in:
Sarah Vaupel 2021-10-21 14:58:08 +02:00
parent 9b45d007bc
commit adf9709567
1 changed files with 45 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

87
src/Foundation/Navigation.hs
View File

@ -573,8 +573,8 @@ navLinkAccess NavLink{..} = case navAccess' of
defaultLinks :: ( MonadHandler m
, HandlerSite m ~ UniWorX
, MonadThrow m
, WithRunDB SqlReadBackend (HandlerFor UniWorX) m
-- , MonadThrow m
-- , WithRunDB SqlReadBackend (HandlerFor UniWorX) m
, BearerAuthSite UniWorX
) => m [Nav]
defaultLinks = fmap catMaybes . mapM runMaybeT $ -- Define the menu items of the header.
@ -761,12 +761,14 @@ defaultLinks = fmap catMaybes . mapM runMaybeT $ -- Define the menu items of the
, do
guardVolatile clusterVolatileWorkflowsEnabled
authCtx <- getAuthContext
(haveInstances, haveWorkflows) <- lift . memcachedBy (Just . Right $ 2 * diffMinute) (NavCacheHaveTopWorkflowsInstances authCtx) . useRunDB $ (,)
<$> haveTopWorkflowInstances
<*> haveTopWorkflowWorkflows
-- authCtx <- getAuthContext
-- (haveInstances, haveWorkflows) <- lift . memcachedBy (Just . Right $ 2 * diffMinute) (NavCacheHaveTopWorkflowsInstances authCtx) . useRunDB $ (,)
-- <$> haveTopWorkflowInstances
-- <*> haveTopWorkflowWorkflows
if | haveInstances -> return NavHeader
mUserId <- maybeAuthId
-- if | haveInstances -> return NavHeader
if | isJust mUserId -> return NavHeader
{ navHeaderRole = NavHeaderPrimary
, navIcon = IconMenuWorkflows
, navLink = NavLink
@ -778,18 +780,18 @@ defaultLinks = fmap catMaybes . mapM runMaybeT $ -- Define the menu items of the
, navForceActive = False
}
}
| haveWorkflows -> return NavHeader
{ navHeaderRole = NavHeaderPrimary
, navIcon = IconMenuWorkflows
, navLink = NavLink
{ navLabel = MsgMenuTopWorkflowWorkflowListHeader
, navRoute = TopWorkflowWorkflowListR
, navAccess' = NavAccessTrue
, navType = NavTypeLink { navModal = False }
, navQuick' = mempty
, navForceActive = False
}
}
-- | haveWorkflows -> return NavHeader
-- { navHeaderRole = NavHeaderPrimary
-- , navIcon = IconMenuWorkflows
-- , navLink = NavLink
-- { navLabel = MsgMenuTopWorkflowWorkflowListHeader
-- , navRoute = TopWorkflowWorkflowListR
-- , navAccess' = NavAccessTrue
-- , navType = NavTypeLink { navModal = False }
-- , navQuick' = mempty
-- , navForceActive = False
-- }
-- }
| otherwise -> mzero
, return NavHeaderContainer
{ navHeaderRole = NavHeaderPrimary
@ -2730,34 +2732,35 @@ haveWorkflowWorkflows rScope = hoist liftHandler . withReaderT (projectBackend @
lift $ anyM roles evalRole
haveTopWorkflowInstances, haveTopWorkflowWorkflows
-- haveTopWorkflowInstances,
haveTopWorkflowWorkflows
:: ( MonadHandler m, HandlerSite m ~ UniWorX
, BackendCompatible SqlReadBackend backend
, BearerAuthSite UniWorX
)
=> ReaderT backend m Bool
haveTopWorkflowInstances = hoist liftHandler . withReaderT (projectBackend @SqlReadBackend) . $cachedHere . maybeT (return False) $ do
roles <- memcachedBy @(Set ((RouteWorkflowScope, WorkflowInstanceName), WorkflowRole UserId)) (Just $ Right diffDay) NavCacheHaveTopWorkflowInstancesRoles $ do
let
getInstances = E.selectSource . E.from $ \workflowInstance -> do
E.where_ . isTopWorkflowScopeSql $ workflowInstance E.^. WorkflowInstanceScope
return workflowInstance
instanceRoles (Entity _ WorkflowInstance{..}) = do
rScope <- toRouteWorkflowScope $ _DBWorkflowScope # workflowInstanceScope
wiGraph <- lift $ getSharedIdWorkflowGraph workflowInstanceGraph
return . Set.mapMonotonic ((rScope, workflowInstanceName), ) . fold $ do
WGN{..} <- wiGraph ^.. _wgNodes . folded
WorkflowGraphEdgeInitial{..} <- wgnEdges ^.. folded
return wgeActors
runConduit $ transPipe lift getInstances .| C.foldMapM instanceRoles
let
evalRole :: _ -> ReaderT SqlReadBackend (HandlerFor UniWorX) Bool
evalRole ((rScope, win), role) = do
let route = _WorkflowScopeRoute # (rScope, WorkflowInstanceR win WIInitiateR)
is _Authorized <$> hasWorkflowRole Nothing role route False
lift $ anyM roles evalRole
-- haveTopWorkflowInstances = hoist liftHandler . withReaderT (projectBackend @SqlReadBackend) . $cachedHere . maybeT (return False) $ do
-- roles <- memcachedBy @(Set ((RouteWorkflowScope, WorkflowInstanceName), WorkflowRole UserId)) (Just $ Right diffDay) NavCacheHaveTopWorkflowInstancesRoles $ do
-- let
-- getInstances = E.selectSource . E.from $ \workflowInstance -> do
-- E.where_ . isTopWorkflowScopeSql $ workflowInstance E.^. WorkflowInstanceScope
-- return workflowInstance
-- instanceRoles (Entity _ WorkflowInstance{..}) = do
-- rScope <- toRouteWorkflowScope $ _DBWorkflowScope # workflowInstanceScope
-- wiGraph <- lift $ getSharedIdWorkflowGraph workflowInstanceGraph
-- return . Set.mapMonotonic ((rScope, workflowInstanceName), ) . fold $ do
-- WGN{..} <- wiGraph ^.. _wgNodes . folded
-- WorkflowGraphEdgeInitial{..} <- wgnEdges ^.. folded
-- return wgeActors
-- runConduit $ transPipe lift getInstances .| C.foldMapM instanceRoles
--
-- let
-- evalRole :: _ -> ReaderT SqlReadBackend (HandlerFor UniWorX) Bool
-- evalRole ((rScope, win), role) = do
-- let route = _WorkflowScopeRoute # (rScope, WorkflowInstanceR win WIInitiateR)
-- is _Authorized <$> hasWorkflowRole Nothing role route False
--
-- lift $ anyM roles evalRole
haveTopWorkflowWorkflows = hoist liftHandler . withReaderT (projectBackend @SqlReadBackend) . $cachedHere . maybeT (return False) $ do
roles <- memcachedBy (Just $ Right diffDay) NavCacheHaveTopWorkflowWorkflowsRoles $ do
let