feat(workflows): further work on WorkflowWorkflowWorkflow

This commit is contained in:
Gregor Kleen 2020-10-28 15:59:16 +01:00
parent 3e6935490b
commit 5b897c7a42
13 changed files with 389 additions and 202 deletions

View File

@ -1426,3 +1426,69 @@ pre, tt, code
.workflow-instance--actions .workflow-instance--actions
margin: 0 0 0.5rem 11px margin: 0 0 0.5rem 11px
.workflow-history
@extend .list--iconless
display: flex
flex-direction: column
position: relative
.workflow-history--item
border: 1px solid var(--color-grey)
align-self: flex-start
padding: 7px
margin: 12px 0
min-width: 45%
display: grid
grid-template-areas: 'user time' 'action-states action-states' 'payload payload'
&.workflow-history-item__self
align-self: flex-end
&:last-child
margin-bottom: 0
&:first-child
margin-bottom: 0
.workflow-history--item-user
grid-area: user
.workflow-history--item-time
grid-area: time
text-align: right
.workflow-history--item-action-states
grid-area: action-states
margin-top: 7px
.deflist__dt, .deflist__dd
padding-top: 0
padding-bottom: 0
.workflow-history--item-payload-changes
grid-area: payload
margin-top: 12px
border-top: 1px solid var(--color-grey)
padding-top: 12px
.workflow-history--item-payload-changes-label
font-size: 20px
font-weight: 600
.workflow-history--item-user-special, .workflow-history--item-action-special, .workflow-history--item-state-special
@extend .explanation
.workflow-state
margin-top: 7px
.deflist__dt, .deflist__dd
padding-top: 0
padding-bottom: 0
.workflow-payload
margin-top: 12px
.workflow-payload--label
font-size: 20px
font-weight: 600

View File

@ -231,8 +231,6 @@ export class Datepicker {
// format the date value of the form input element of this datepicker before form submission // format the date value of the form input element of this datepicker before form submission
this._element.form.addEventListener('submit', this._submitHandler.bind(this)); this._element.form.addEventListener('submit', this._submitHandler.bind(this));
window.addEventListener('beforeunload', this._beforeUnloadHandler.bind(this));
} }
destroy() { destroy() {
@ -276,23 +274,6 @@ export class Datepicker {
this.formatElementValue(true); this.formatElementValue(true);
}); });
} }
/**
* Restore input element to it's original type and format it's new value for input-value persisting by the browser
*/
_beforeUnloadHandler() {
if (this._unloadIsDueToSubmit)
return;
let oldValue = this._element.value;
let newValue = this.unformat(false);
this._element.type = this.elementType;
this._element.value = newValue;
defer(() => { // Restore state after event loop is settled
this._element.setAttribute('type', 'text');
this._element.value = oldValue;
});
}
/** /**
* Returns a datestring in internal format from the current state of the input element value. * Returns a datestring in internal format from the current state of the input element value.

View File

@ -98,9 +98,8 @@ export class NavigateAwayPrompt {
// allow the event to happen if the form was not touched by the // allow the event to happen if the form was not touched by the
// user (i.e. if the current FormData is equal to the initial FormData) // user (i.e. if the current FormData is equal to the initial FormData)
// or the unload event was initiated by a form submit // or the unload event was initiated by a form submit
if (!formDataHasChanged || this._unloadDueToSubmit) { if (!formDataHasChanged || this._unloadDueToSubmit)
return false; return;
}
// cancel the unload event. This is the standard to force the prompt to appear. // cancel the unload event. This is the standard to force the prompt to appear.
event.preventDefault(); event.preventDefault();

View File

@ -3017,7 +3017,15 @@ WorkflowWorkflowWorkflowHistoryUserHidden: Versteckter Benutzer
WorkflowWorkflowWorkflowHistoryUserAutomatic: Automatisch WorkflowWorkflowWorkflowHistoryUserAutomatic: Automatisch
WorkflowWorkflowWorkflowHistoryActionAutomatic: Automatisch WorkflowWorkflowWorkflowHistoryActionAutomatic: Automatisch
WorkflowWorkflowWorkflowHistoryStateHidden: Versteckter Zustand WorkflowWorkflowWorkflowHistoryStateHidden: Versteckter Zustand
WorkflowWorkflowWorkflowHistoryActionLabel: Aktion
WorkflowWorkflowWorkflowHistoryFromLabel: Vorheriger Zustand
WorkflowWorkflowWorkflowHistoryToLabel: Neuer Zustand
WorkflowWorkflowWorkflowHistoryPayloadLabel: Datensatz-Änderungen
WorkflowWorkflowFilesArchiveName wwCID@CryptoFileNameWorkflowWorkflow wpl@WorkflowPayloadLabel stCID@CryptoUUIDWorkflowStateIndex: #{foldCase (toPathPiece wwCID)}-#{foldCase (toPathPiece stCID)}-#{foldCase (foldMap unidecode (toPathPiece wpl))}.zip WorkflowWorkflowFilesArchiveName wwCID@CryptoFileNameWorkflowWorkflow wpl@WorkflowPayloadLabel stCID@CryptoUUIDWorkflowStateIndex: #{foldCase (toPathPiece wwCID)}-#{foldCase (toPathPiece stCID)}-#{foldCase (foldMap unidecode (toPathPiece wpl))}.zip
WorkflowWorkflowWorkflowStateHeading: Zustand/Daten
WorkflowWorkflowWorkflowPayloadHeading: Aktueller Datensatz
WorkflowWorkflowWorkflowStateStateLabel: Aktueller Zustand
WorkflowWorkflowWorkflowStateStateHidden: Versteckter Zustand
WorkflowPayloadFiles: Datei(en) WorkflowPayloadFiles: Datei(en)
WorkflowPayloadBoolTrue: Ja WorkflowPayloadBoolTrue: Ja

View File

@ -16,6 +16,7 @@ module Foundation.Authorization
, orAR, andAR, notAR, trueAR, falseAR , orAR, andAR, notAR, trueAR, falseAR
, evalWorkflowRoleFor, evalWorkflowRoleFor' , evalWorkflowRoleFor, evalWorkflowRoleFor'
, hasWorkflowRole , hasWorkflowRole
, mayViewWorkflowAction
) where ) where
import Import.NoFoundation hiding (Last(..)) import Import.NoFoundation hiding (Last(..))
@ -38,7 +39,7 @@ import qualified Data.HashSet as HashSet
import qualified Data.Map as Map import qualified Data.Map as Map
import Data.Map ((!?)) import Data.Map ((!?))
import qualified Data.Text as Text import qualified Data.Text as Text
import Data.List (findIndex) import Data.List (findIndex, inits)
import Data.Semigroup (Last(..)) import Data.Semigroup (Last(..))
import qualified Database.Esqueleto as E import qualified Database.Esqueleto as E
@ -1416,9 +1417,11 @@ tagAccessPredicate AuthWorkflow = APDB $ \mAuthId route isWrite -> do
WorkflowNodeView{..} <- hoistMaybe wgnViewers WorkflowNodeView{..} <- hoistMaybe wgnViewers
return $ toNullable wnvViewers return $ toNullable wnvViewers
payloadViewers = do payloadViewers = do
WorkflowAction{..} <- otoList workflowWorkflowState (prevActs, act) <- zip (inits $ otoList workflowWorkflowState) $ otoList workflowWorkflowState
payload <- Map.keys wpPayload prevAct <- hoistMaybe $ prevActs ^? _last
fmap (toNullable . wpvViewers) . hoistMaybe $ wgPayloadView wwGraph Map.!? payload payload <- Map.keys $ wpPayload act
guard $ Map.lookup payload (workflowStateCurrentPayloads prevActs) /= Map.lookup payload (wpPayload act)
fmap (toNullable . wpvViewers) . hoistMaybe $ Map.lookup payload . wgnPayloadView =<< Map.lookup (wpTo prevAct) (wgNodes wwGraph)
evalRole role = lift $ evalWorkflowRoleFor mAuthId (Just wwId) role route isWrite evalRole role = lift $ evalWorkflowRoleFor mAuthId (Just wwId) role route isWrite
guardM . fmap (is _Authorized) $ ofoldr1 orAR' . mapNonNull evalRole =<< hoistMaybe (fromNullable . otoList $ fold nodeViewers <> fold payloadViewers) guardM . fmap (is _Authorized) $ ofoldr1 orAR' . mapNonNull evalRole =<< hoistMaybe (fromNullable . otoList $ fold nodeViewers <> fold payloadViewers)
@ -1430,13 +1433,13 @@ tagAccessPredicate AuthWorkflow = APDB $ \mAuthId route isWrite -> do
let let
wwGraph :: WorkflowGraph FileReference UserId wwGraph :: WorkflowGraph FileReference UserId
wwGraph = workflowWorkflowGraph & over (typesCustom @WorkflowChildren) (review _SqlKey :: SqlBackendKey -> UserId) wwGraph = workflowWorkflowGraph & over (typesCustom @WorkflowChildren) (review _SqlKey :: SqlBackendKey -> UserId)
act <- workflowStateIndex stIx $ _DBWorkflowState # workflowWorkflowState
payloadViewers = Map.findWithDefault Set.empty wpl $ toNullable . wpvViewers <$> wgPayloadView wwGraph let
cState = wpTo act
payloadViewers = Map.findWithDefault Set.empty wpl $ toNullable . wpvViewers <$> Map.findWithDefault Map.empty cState (wgnPayloadView <$> wgNodes wwGraph)
evalRole role = lift $ evalWorkflowRoleFor mAuthId (Just wwId) role route isWrite evalRole role = lift $ evalWorkflowRoleFor mAuthId (Just wwId) role route isWrite
guardM . anyM (otoList payloadViewers) $ fmap (is _Authorized) . evalRole guardM . anyM (otoList payloadViewers) $ fmap (is _Authorized) . evalRole
WorkflowAction{wpTo} <- workflowStateIndex stIx workflowWorkflowState guardM . lift $ mayViewWorkflowAction mAuthId wwId act
WorkflowNodeView{wnvViewers} <- hoistMaybe $ wgnViewers =<< wgNodes wwGraph Map.!? wpTo
guardM . anyM (otoList wnvViewers) $ fmap (is _Authorized) . evalRole
return Authorized return Authorized
case route of case route of
@ -1686,3 +1689,32 @@ hasWorkflowRole :: ( MonadHandler m
hasWorkflowRole mwwId wRole route isWrite = do hasWorkflowRole mwwId wRole route isWrite = do
mAuthId <- maybeAuthId mAuthId <- maybeAuthId
evalWorkflowRoleFor mAuthId mwwId wRole route isWrite evalWorkflowRoleFor mAuthId mwwId wRole route isWrite
mayViewWorkflowAction :: forall backend m fileid.
( MonadHandler m
, HandlerSite m ~ UniWorX
, BearerAuthSite UniWorX
, BackendCompatible SqlReadBackend backend
, MonadCrypto m, MonadCryptoKey m ~ CryptoIDKey
, MonadCatch m
)
=> Maybe UserId
-> WorkflowWorkflowId
-> WorkflowAction fileid UserId
-> ReaderT backend m Bool
mayViewWorkflowAction mAuthId wwId WorkflowAction{..} = withReaderT (projectBackend @SqlReadBackend) . maybeT (return False) $ do
WorkflowWorkflow{..} <- MaybeT $ get wwId
rScope <- toRouteWorkflowScope $ _DBWorkflowScope # workflowWorkflowScope
cID <- catchMaybeT (Proxy @CryptoIDError) . lift $ encrypt wwId
let WorkflowGraph{..} = _DBWorkflowGraph # workflowWorkflowGraph
canonRoute = _WorkflowScopeRoute # (rScope, WorkflowWorkflowR cID WWWorkflowR)
evalWorkflowRole' role = lift $ is _Authorized <$> evalWorkflowRoleFor mAuthId (Just wwId) role canonRoute False
WorkflowNodeView{..} <- hoistMaybe $ Map.lookup wpTo wgNodes >>= wgnViewers
guardM $ orM
[ return $ is _Just mAuthId && wpUser == Just mAuthId
, anyM wnvViewers evalWorkflowRole'
, anyM (Map.keys wpPayload) $ \payloadLbl -> maybeT (return False) $ do
WorkflowPayloadView{..} <- hoistMaybe . Map.lookup payloadLbl $ Map.findWithDefault Map.empty wpTo (wgnPayloadView <$> wgNodes)
lift $ anyM wpvViewers evalWorkflowRole'
]
return True

View File

@ -257,7 +257,7 @@ routeNormalizers = map (hoist (hoist liftHandler . withReaderT projectBackend) .
(_, WorkflowWorkflowR cID (WWFilesR wpl _)) <- hoistMaybe $ route ^? _WorkflowScopeRoute (_, WorkflowWorkflowR cID (WWFilesR wpl _)) <- hoistMaybe $ route ^? _WorkflowScopeRoute
wwId <- decrypt cID wwId <- decrypt cID
WorkflowWorkflow{..} <- MaybeT . $cachedHereBinary wwId . lift $ get wwId WorkflowWorkflow{..} <- MaybeT . $cachedHereBinary wwId . lift $ get wwId
[wpl'] <- return . filter (== wpl) . Map.keys $ wgPayloadView workflowWorkflowGraph [wpl'] <- return . filter (== wpl) . sortOn (CI.original . unWorkflowPayloadLabel) . foldMap Map.keys $ wgnPayloadView <$> wgNodes workflowWorkflowGraph
(caseChanged `on` unWorkflowPayloadLabel) wpl wpl' (caseChanged `on` unWorkflowPayloadLabel) wpl wpl'
return $ route return $ route
& typesUsing @RouteChildren @WorkflowPayloadLabel . filtered (== wpl) .~ wpl' & typesUsing @RouteChildren @WorkflowPayloadLabel . filtered (== wpl) .~ wpl'

View File

@ -68,7 +68,7 @@ workflowEdgeForm :: ( MonadHandler m
, HandlerSite m ~ UniWorX , HandlerSite m ~ UniWorX
, MonadHandler m' , MonadHandler m'
, HandlerSite m' ~ UniWorX , HandlerSite m' ~ UniWorX
, MonadThrow m' , MonadCatch m'
) )
=> Either WorkflowInstanceId WorkflowWorkflowId => Either WorkflowInstanceId WorkflowWorkflowId
-> Maybe WorkflowEdgeForm -> Maybe WorkflowEdgeForm
@ -84,8 +84,12 @@ workflowEdgeForm mwwId mPrev = runMaybeT $ do
Right WorkflowWorkflow{..} -> ( _DBWorkflowScope # workflowWorkflowScope Right WorkflowWorkflow{..} -> ( _DBWorkflowScope # workflowWorkflowScope
, _DBWorkflowGraph # workflowWorkflowGraph , _DBWorkflowGraph # workflowWorkflowGraph
) )
wPayload = ctx ^? _Right . _workflowWorkflowState . re _DBWorkflowState . to workflowStateCurrentPayloads
wState = ctx ^? _Right . _workflowWorkflowState . to last . _wpTo wState = ctx ^? _Right . _workflowWorkflowState . to last . _wpTo
wPayload' = ctx ^? _Right . _workflowWorkflowState . re _DBWorkflowState
mAuthId <- maybeAuthId
wPayload <- case mwwId of
Right wwId -> workflowStateCurrentPayloads <$> filterM (lift . hoist liftHandler . mayViewWorkflowAction mAuthId wwId) (maybe [] otoList wPayload')
Left _ -> return Map.empty
rScope <- toRouteWorkflowScope scope rScope <- toRouteWorkflowScope scope
@ -146,7 +150,7 @@ workflowEdgeForm mwwId mPrev = runMaybeT $ do
let edges' = flip sortOn edges $ \(edgeIdent, _) -> flip findIndex (olOptions edgesOptList) $ (== edgeIdent) . optionInternalValue let edges' = flip sortOn edges $ \(edgeIdent, _) -> flip findIndex (olOptions edgesOptList) $ (== edgeIdent) . optionInternalValue
let edgeForms :: Map (WorkflowGraphNodeLabel, WorkflowGraphEdgeLabel) (AForm Handler WorkflowEdgeForm) let edgeForms :: Map (WorkflowGraphNodeLabel, WorkflowGraphEdgeLabel) (AForm Handler WorkflowEdgeForm)
edgeForms = Map.fromList . flip map edges' $ \(edgeIdent, (_, WorkflowGraphEdgeForm{..})) -> (edgeIdent, ) . fmap (WorkflowEdgeForm edgeIdent) . wFormToAForm . fmap sequenceA $ do edgeForms = Map.fromList . flip map edges' $ \(edgeIdent@(tState, _), (_, WorkflowGraphEdgeForm{..})) -> (edgeIdent, ) . fmap (WorkflowEdgeForm edgeIdent) . wFormToAForm . fmap sequenceA $ do
let fieldSort :: [(WorkflowPayloadLabel, [[(Either WorkflowGraphEdgeFormOrder ByteString, WorkflowPayloadSpec FileReference UserId)]])] let fieldSort :: [(WorkflowPayloadLabel, [[(Either WorkflowGraphEdgeFormOrder ByteString, WorkflowPayloadSpec FileReference UserId)]])]
-> _ -> _
fieldSort fieldSort
@ -166,7 +170,7 @@ workflowEdgeForm mwwId mPrev = runMaybeT $ do
orderedFields' <- flip evalStateT 1 . for orderedFields $ \x@(payloadLabel, _) -> do orderedFields' <- flip evalStateT 1 . for orderedFields $ \x@(payloadLabel, _) -> do
let generateDisplayLabel = State.state $ \n -> (mr $ MsgWorkflowEdgeFormHiddenPayload n, succ n) let generateDisplayLabel = State.state $ \n -> (mr $ MsgWorkflowEdgeFormHiddenPayload n, succ n)
(mayView, payloadDisplayLabel) <- hoist (lift . lift . runDB) . maybeT ((False, ) <$> generateDisplayLabel) $ do (mayView, payloadDisplayLabel) <- hoist (lift . lift . runDB) . maybeT ((False, ) <$> generateDisplayLabel) $ do
WorkflowPayloadView{..} <- hoistMaybe . Map.lookup payloadLabel $ wgPayloadView graph WorkflowPayloadView{..} <- hoistMaybe . Map.lookup payloadLabel $ Map.findWithDefault Map.empty (fromMaybe tState wState) (wgnPayloadView <$> wgNodes graph)
wRoute <- case (mwwId, ctx) of wRoute <- case (mwwId, ctx) of
(Right wwId, Right _) -> do (Right wwId, Right _) -> do
cID <- encrypt wwId cID <- encrypt wwId
@ -184,7 +188,7 @@ workflowEdgeForm mwwId mPrev = runMaybeT $ do
payloadFields = workflowEdgePayloadFields payloadSpecs' $ fmap otoList . Map.lookup payloadLabel =<< prevSrc payloadFields = workflowEdgePayloadFields payloadSpecs' $ fmap otoList . Map.lookup payloadLabel =<< prevSrc
where prevSrc = asum where prevSrc = asum
[ wefPayload <$> assertM ((== edgeIdent) . wefEdge) mPrev [ wefPayload <$> assertM ((== edgeIdent) . wefEdge) mPrev
, guardOnM mayView wPayload , guardOn mayView wPayload
] ]
((payloadRes, isOptional), payloadFieldViews) <- wFormFields payloadFields ((payloadRes, isOptional), payloadFieldViews) <- wFormFields payloadFields
return ((payloadDisplayLabel, getAll isOptional), (payloadRes, payloadFieldViews)) return ((payloadDisplayLabel, getAll isOptional), (payloadRes, payloadFieldViews))

View File

@ -46,7 +46,7 @@ followAutomaticEdges :: forall m.
-> WorkflowState FileReference UserId -> m (WorkflowState FileReference UserId) -> WorkflowState FileReference UserId -> m (WorkflowState FileReference UserId)
followAutomaticEdges WorkflowGraph{..} = go [] followAutomaticEdges WorkflowGraph{..} = go []
where where
go :: [(Set WorkflowPayloadLabel, (WorkflowGraphEdgeLabel, WorkflowGraphNodeLabel))] -- ^ Should encode all state from which automatic edges decide whether they can be followed go :: [((WorkflowGraphNodeLabel, Set WorkflowPayloadLabel), (WorkflowGraphEdgeLabel, WorkflowGraphNodeLabel))] -- ^ Should encode all state from which automatic edges decide whether they can be followed
-> WorkflowState FileReference UserId -> WorkflowState FileReference UserId
-> m (WorkflowState FileReference UserId) -> m (WorkflowState FileReference UserId)
go automaticEdgesTaken history go automaticEdgesTaken history
@ -68,14 +68,16 @@ followAutomaticEdges WorkflowGraph{..} = go []
(nodeLbl, WGN{..}) <- Map.toList wgNodes (nodeLbl, WGN{..}) <- Map.toList wgNodes
(edgeLbl, WorkflowGraphEdgeAutomatic{..}) <- Map.toList wgnEdges (edgeLbl, WorkflowGraphEdgeAutomatic{..}) <- Map.toList wgnEdges
guard $ wgeSource == cState guard $ wgeSource == cState
whenIsJust wgePayloadRestriction $ guard . checkPayloadRestriction whenIsJust wgeRestriction $ guard . checkRestriction
return (edgeLbl, nodeLbl) return (edgeLbl, nodeLbl)
checkPayloadRestriction :: PredDNF WorkflowPayloadLabel -> Bool checkRestriction :: PredDNF WorkflowGraphEdgeAutomaticRestriction -> Bool
checkPayloadRestriction dnf = maybe False (ofoldr1 (||)) . fromNullable $ map evalConj dnf' checkRestriction dnf = maybe False (ofoldr1 (||)) . fromNullable $ map evalConj dnf'
where where
evalConj = maybe True (ofoldr1 (&&)) . fromNullable . map evalPred evalConj = maybe True (ofoldr1 (&&)) . fromNullable . map evalPred
evalPred PLVariable{..} = plVar `Set.member` filledPayloads evalPred PLVariable{ plVar = WorkflowGraphEdgeAutomaticRestrictionPayloadFilled{..} } = wgearPayloadFilled `Set.member` filledPayloads
evalPred PLNegated{..} = plVar `Set.notMember` filledPayloads evalPred PLNegated{ plVar = WorkflowGraphEdgeAutomaticRestrictionPayloadFilled{..} } = wgearPayloadFilled `Set.notMember` filledPayloads
evalPred PLVariable{ plVar = WorkflowGraphEdgeAutomaticRestrictionPreviousNode{..} } = wgearPreviousNode == cState
evalPred PLNegated{ plVar = WorkflowGraphEdgeAutomaticRestrictionPreviousNode{..} } = wgearPreviousNode /= cState
dnf' = map (Set.toList . toNullable) . Set.toList $ dnfTerms dnf dnf' = map (Set.toList . toNullable) . Set.toList $ dnfTerms dnf
filledPayloads = Map.keysSet . Map.filter (not . Set.null) $ workflowStateCurrentPayloads history filledPayloads = Map.keysSet . Map.filter (not . Set.null) $ workflowStateCurrentPayloads history
edgeDecisionInput = filledPayloads edgeDecisionInput = (cState, filledPayloads)

View File

@ -4,11 +4,13 @@ module Handler.Workflow.Workflow.Workflow
, workflowR , workflowR
) where ) where
import Import import Import hiding (Last(..))
import Utils.Form import Utils.Form
import Utils.Workflow import Utils.Workflow
import Data.Semigroup (Last(..))
import Handler.Utils import Handler.Utils
import Handler.Utils.Workflow.EdgeForm import Handler.Utils.Workflow.EdgeForm
import Handler.Utils.Workflow.CanonicalRoute import Handler.Utils.Workflow.CanonicalRoute
@ -16,7 +18,6 @@ import Handler.Utils.Workflow.Workflow
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Data.Set as Set import qualified Data.Set as Set
import qualified Data.Sequence as Seq
import qualified Control.Monad.State.Class as State import qualified Control.Monad.State.Class as State
import Control.Monad.Trans.RWS.Strict (RWST, execRWST) import Control.Monad.Trans.RWS.Strict (RWST, execRWST)
@ -29,12 +30,12 @@ import Crypto.Hash.Algorithms (SHAKE256)
import qualified Data.Text as Text import qualified Data.Text as Text
import Data.RFC5051 (compareUnicode) import Data.RFC5051 (compareUnicode)
import Data.List (inits)
import qualified Data.Scientific as Scientific import qualified Data.Scientific as Scientific
import Text.Blaze (toMarkup) import Text.Blaze (toMarkup)
import Data.Void (absurd) import Data.Void (absurd)
import Data.List (inits)
data WorkflowHistoryItemActor = WHIASelf | WHIAOther (Maybe (Entity User)) | WHIAHidden | WHIAGone data WorkflowHistoryItemActor = WHIASelf | WHIAOther (Maybe (Entity User)) | WHIAHidden | WHIAGone
deriving (Generic, Typeable) deriving (Generic, Typeable)
@ -45,9 +46,14 @@ data WorkflowHistoryItem = WorkflowHistoryItem
, whiPayloadChanges :: [(Text, ([WorkflowFieldPayloadW Void (Maybe (Entity User))], Maybe (Route UniWorX)))] , whiPayloadChanges :: [(Text, ([WorkflowFieldPayloadW Void (Maybe (Entity User))], Maybe (Route UniWorX)))]
, whiFrom :: Maybe (Maybe Text) -- ^ outer maybe encodes existence, inner maybe encodes permission to view , whiFrom :: Maybe (Maybe Text) -- ^ outer maybe encodes existence, inner maybe encodes permission to view
, whiVia :: Maybe Text , whiVia :: Maybe Text
, whiTo :: Text , whiTo :: Maybe Text
} deriving (Generic, Typeable) } deriving (Generic, Typeable)
data WorkflowCurrentState = WorkflowCurrentState
{ wcsState :: Maybe Text
, wcsPayload :: [(Text, ([WorkflowFieldPayloadW Void (Maybe (Entity User))], Maybe (Route UniWorX)))]
}
makePrisms ''WorkflowHistoryItemActor makePrisms ''WorkflowHistoryItemActor
@ -62,7 +68,7 @@ workflowR :: WorkflowWorkflowId -> Handler Html
workflowR wwId = do workflowR wwId = do
cID <- encrypt wwId cID <- encrypt wwId
(mEdge, rScope, workflowHistory) <- runDB $ do (mEdge, rScope, (workflowState, workflowHistory)) <- runDB $ do
WorkflowWorkflow{..} <- get404 wwId WorkflowWorkflow{..} <- get404 wwId
rScope <- maybeT notFound . toRouteWorkflowScope $ _DBWorkflowScope # workflowWorkflowScope rScope <- maybeT notFound . toRouteWorkflowScope $ _DBWorkflowScope # workflowWorkflowScope
mEdgeForm <- workflowEdgeForm (Right wwId) Nothing mEdgeForm <- workflowEdgeForm (Right wwId) Nothing
@ -81,18 +87,21 @@ workflowR wwId = do
redirect canonRoute redirect canonRoute
return ((edgeAct, edgeView), edgeEnc) return ((edgeAct, edgeView), edgeEnc)
workflowHistory <- (fmap getLast -> workflowState, workflowHistory) <-
let go :: forall m. let go :: forall m.
( MonadHandler m ( MonadHandler m
, HandlerSite m ~ UniWorX , HandlerSite m ~ UniWorX
, MonadThrow m , MonadCatch m
) )
=> WorkflowStateIndex => WorkflowStateIndex
-> Maybe WorkflowGraphNodeLabel -> Maybe WorkflowGraphNodeLabel
-> Map WorkflowPayloadLabel (Set (WorkflowFieldPayloadW FileReference UserId)) -> Map WorkflowPayloadLabel (Set (WorkflowFieldPayloadW FileReference UserId))
-> WorkflowAction FileReference UserId -> WorkflowAction FileReference UserId
-> RWST () [WorkflowHistoryItem] (Map WorkflowPayloadLabel (Set (WorkflowFieldPayloadW FileReference UserId))) (SqlPersistT m) () -> RWST () (Maybe (Last WorkflowCurrentState), [WorkflowHistoryItem]) (Map WorkflowPayloadLabel (Set (WorkflowFieldPayloadW FileReference UserId))) (SqlPersistT m) ()
go stIx wpFrom currentPayload WorkflowAction{..} = maybeT (return ()) $ do go stIx wpFrom currentPayload act@WorkflowAction{..} = maybeT (return ()) $ do
mAuthId <- maybeAuthId
guardM . lift . lift . hoist liftHandler $ mayViewWorkflowAction mAuthId wwId act
stCID <- encrypt stIx stCID <- encrypt stIx
let nodeView nodeLbl = do let nodeView nodeLbl = do
WorkflowNodeView{..} <- hoistMaybe $ Map.lookup nodeLbl wgNodes >>= wgnViewers WorkflowNodeView{..} <- hoistMaybe $ Map.lookup nodeLbl wgNodes >>= wgnViewers
@ -102,62 +111,9 @@ workflowR wwId = do
mVia = Map.lookup wpVia . wgnEdges =<< Map.lookup wpTo wgNodes mVia = Map.lookup wpVia . wgnEdges =<< Map.lookup wpTo wgNodes
hasWorkflowRole' role = $cachedHereBinary (rScope, wwId, role) . lift . lift $ is _Authorized <$> hasWorkflowRole (Just wwId) role canonRoute False hasWorkflowRole' role = $cachedHereBinary (rScope, wwId, role) . lift . lift $ is _Authorized <$> hasWorkflowRole (Just wwId) role canonRoute False
whiTo <- nodeView wpTo whiTo <- lift . runMaybeT $ nodeView wpTo
whiVia <- traverse selectLanguageI18n $ preview _wgeDisplayLabel =<< mVia let wcsState = whiTo
payloadChanges <- State.state $ \oldPayload ->
( Map.filterWithKey (\k v -> Map.findWithDefault Set.empty k oldPayload /= v) currentPayload
, currentPayload
)
sBoxKey <- secretBoxKey
let payloadLabelToDigest :: WorkflowPayloadLabel -> ByteString
payloadLabelToDigest = BA.convert . kmaclazy @(SHAKE256 256) ("workflow-workflow-payload-sorting" :: ByteString) (Saltine.encode sBoxKey) . Binary.encode . (wwId, )
payloadLabelSort = (compareUnicode `on` views (_2 . _1) Text.toLower)
<> comparing (views _1 payloadLabelToDigest)
whiPayloadChanges' <- fmap (map (view _2) . sortBy payloadLabelSort) . forMaybeM (Map.toList payloadChanges) $ \(payloadLbl, newPayload) -> do
WorkflowPayloadView{..} <- hoistMaybe $ Map.lookup payloadLbl wgPayloadView
guardM . anyM (otoList wpvViewers) $ lift . hasWorkflowRole'
let fRoute = _WorkflowScopeRoute # (rScope, WorkflowWorkflowR cID (WWFilesR payloadLbl stCID))
(payloadLbl, ) . (, (newPayload, fRoute)) <$> selectLanguageI18n wpvDisplayLabel
let
payloadSort :: WorkflowFieldPayloadW Void (Maybe (Entity User))
-> WorkflowFieldPayloadW Void (Maybe (Entity User))
-> Ordering
payloadSort (WorkflowFieldPayloadW a) (WorkflowFieldPayloadW b) = case (a, b) of
(WFPText a', WFPText b' ) -> compareUnicode a' b'
(WFPText{}, _ ) -> LT
(WFPNumber a', WFPNumber b') -> compare a' b'
(WFPNumber{}, WFPText{} ) -> GT
(WFPNumber{}, _ ) -> LT
(WFPBool a', WFPBool b' ) -> compare a' b'
(WFPBool{}, WFPText{} ) -> GT
(WFPBool{}, WFPNumber{} ) -> GT
(WFPBool{}, _ ) -> LT
(WFPDay a', WFPDay b' ) -> compare a' b'
(WFPDay{}, WFPText{} ) -> GT
(WFPDay{}, WFPNumber{} ) -> GT
(WFPDay{}, WFPBool{} ) -> GT
(WFPDay{}, _ ) -> LT
(WFPFile a', _ ) -> absurd a'
(WFPUser a', WFPUser b' ) -> case (a', b') of
(Nothing, _) -> GT
(_, Nothing) -> LT
(Just (Entity _ uA), Just (Entity _ uB))
-> (compareUnicode `on` userSurname) uA uB
<> (compareUnicode `on` userDisplayName) uA uB
<> comparing userIdent uA uB
(WFPUser{}, _ ) -> GT
whiPayloadChanges <- flip mapM whiPayloadChanges' $ \(lblText, (otoList -> payloads, fRoute)) -> fmap ((lblText, ) . over _1 (sortBy payloadSort) . over _2 (bool Nothing (Just fRoute). getAny)) . execWriterT . flip mapM_ payloads $ \case
WorkflowFieldPayloadW (WFPText t ) -> tell . (, mempty) . pure $ WorkflowFieldPayloadW (WFPText t)
WorkflowFieldPayloadW (WFPNumber n ) -> tell . (, mempty) . pure $ WorkflowFieldPayloadW (WFPNumber n)
WorkflowFieldPayloadW (WFPBool b ) -> tell . (, mempty) . pure $ WorkflowFieldPayloadW (WFPBool b)
WorkflowFieldPayloadW (WFPDay d ) -> tell . (, mempty) . pure $ WorkflowFieldPayloadW (WFPDay d)
WorkflowFieldPayloadW (WFPFile _ ) -> tell (mempty, Any True)
WorkflowFieldPayloadW (WFPUser uid) -> tell . (, mempty) . pure . review (_WorkflowFieldPayloadW . _WorkflowFieldPayload) =<< lift (lift . lift $ getEntity uid)
whiFrom <- for wpFrom $ lift . runMaybeT . nodeView
mAuthId <- maybeAuthId
whiUser <- for wpUser $ \wpUser' -> if whiUser <- for wpUser $ \wpUser' -> if
| is _Just mAuthId | is _Just mAuthId
, wpUser' == mAuthId -> return WHIASelf , wpUser' == mAuthId -> return WHIASelf
@ -169,17 +125,77 @@ workflowR wwId = do
Nothing -> WHIAOther Nothing Nothing -> WHIAOther Nothing
Just Nothing -> WHIAGone Just Nothing -> WHIAGone
Just (Just uEnt) -> WHIAOther $ Just uEnt Just (Just uEnt) -> WHIAOther $ Just uEnt
tell $ pure WorkflowHistoryItem{..}
whiVia <- traverse selectLanguageI18n $ preview _wgeDisplayLabel =<< mVia
whiFrom <- for wpFrom $ lift . runMaybeT . nodeView
let renderPayload payload = do
sBoxKey <- secretBoxKey
let payloadLabelToDigest :: WorkflowPayloadLabel -> ByteString
payloadLabelToDigest = BA.convert . kmaclazy @(SHAKE256 256) ("workflow-workflow-payload-sorting" :: ByteString) (Saltine.encode sBoxKey) . Binary.encode . (wwId, )
payloadLabelSort = (compareUnicode `on` views (_2 . _1) Text.toLower)
<> comparing (views _1 payloadLabelToDigest)
payload' <- fmap (map (view _2) . sortBy payloadLabelSort) . forMaybeM (Map.toList payload) $ \(payloadLbl, newPayload) -> do
WorkflowPayloadView{..} <- hoistMaybe . Map.lookup payloadLbl $ Map.findWithDefault Map.empty wpTo (wgnPayloadView <$> wgNodes)
guardM . $cachedHereBinary payloadLbl . anyM (otoList wpvViewers) $ lift . hasWorkflowRole'
let fRoute = _WorkflowScopeRoute # (rScope, WorkflowWorkflowR cID (WWFilesR payloadLbl stCID))
(payloadLbl, ) . (, (newPayload, fRoute)) <$> selectLanguageI18n wpvDisplayLabel
let
payloadSort :: WorkflowFieldPayloadW Void (Maybe (Entity User))
-> WorkflowFieldPayloadW Void (Maybe (Entity User))
-> Ordering
payloadSort (WorkflowFieldPayloadW a) (WorkflowFieldPayloadW b) = case (a, b) of
(WFPText a', WFPText b' ) -> compareUnicode a' b'
(WFPText{}, _ ) -> LT
(WFPNumber a', WFPNumber b') -> compare a' b'
(WFPNumber{}, WFPText{} ) -> GT
(WFPNumber{}, _ ) -> LT
(WFPBool a', WFPBool b' ) -> compare a' b'
(WFPBool{}, WFPText{} ) -> GT
(WFPBool{}, WFPNumber{} ) -> GT
(WFPBool{}, _ ) -> LT
(WFPDay a', WFPDay b' ) -> compare a' b'
(WFPDay{}, WFPText{} ) -> GT
(WFPDay{}, WFPNumber{} ) -> GT
(WFPDay{}, WFPBool{} ) -> GT
(WFPDay{}, _ ) -> LT
(WFPFile a', _ ) -> absurd a'
(WFPUser a', WFPUser b' ) -> case (a', b') of
(Nothing, _) -> GT
(_, Nothing) -> LT
(Just (Entity _ uA), Just (Entity _ uB))
-> (compareUnicode `on` userSurname) uA uB
<> (compareUnicode `on` userDisplayName) uA uB
<> comparing userIdent uA uB
(WFPUser{}, _ ) -> GT
flip mapM payload' $ \(lblText, (otoList -> payloads, fRoute)) -> fmap ((lblText, ) . over _1 (sortBy payloadSort) . over _2 (bool Nothing (Just fRoute). getAny)) . execWriterT . flip mapM_ payloads $ \case
WorkflowFieldPayloadW (WFPText t ) -> tell . (, mempty) . pure $ WorkflowFieldPayloadW (WFPText t)
WorkflowFieldPayloadW (WFPNumber n ) -> tell . (, mempty) . pure $ WorkflowFieldPayloadW (WFPNumber n)
WorkflowFieldPayloadW (WFPBool b ) -> tell . (, mempty) . pure $ WorkflowFieldPayloadW (WFPBool b)
WorkflowFieldPayloadW (WFPDay d ) -> tell . (, mempty) . pure $ WorkflowFieldPayloadW (WFPDay d)
WorkflowFieldPayloadW (WFPFile _ ) -> tell (mempty, Any True)
WorkflowFieldPayloadW (WFPUser uid) -> tell . (, mempty) . pure . review (_WorkflowFieldPayloadW . _WorkflowFieldPayload) =<< lift (lift . lift $ getEntity uid)
payloadChanges <- State.state $ \oldPayload ->
( Map.filterWithKey (\k v -> Map.findWithDefault Set.empty k oldPayload /= v) currentPayload
, currentPayload
)
whiPayloadChanges <- renderPayload payloadChanges
wcsPayload <- renderPayload currentPayload
tell ( Just $ Last WorkflowCurrentState{..}
, pure WorkflowHistoryItem{..}
)
WorkflowGraph{..} = _DBWorkflowGraph # workflowWorkflowGraph WorkflowGraph{..} = _DBWorkflowGraph # workflowWorkflowGraph
wState = otoList $ review _DBWorkflowState workflowWorkflowState wState = otoList $ review _DBWorkflowState workflowWorkflowState
in fmap (view _2) . (\act -> execRWST act () Map.empty) $ sequence_ in fmap (over _2 (sortOn (Down . whiTime) . reverse) . view _2) . (\act -> execRWST act () Map.empty) $ sequence_
[ go stIx fromSt payload act [ go stIx fromSt payload act
| fromSt <- Nothing : map (Just . wpTo) wState | fromSt <- Nothing : map (Just . wpTo) wState
| act <- wState | act <- wState
| payload <- map (maybe Map.empty workflowStateCurrentPayloads . fromNullable . Seq.fromList) . tailEx $ inits wState
| stIx <- [minBound..] | stIx <- [minBound..]
| payload <- map workflowStateCurrentPayloads . tailEx $ inits wState
] ]
return (mEdge, rScope, workflowHistory) return (mEdge, rScope, (workflowState, workflowHistory))
sequenceOf_ (_Just . _1 . _1 . _Just) mEdge sequenceOf_ (_Just . _1 . _1 . _Just) mEdge
@ -223,7 +239,8 @@ getGWWFilesR wwCID wpl stCID = do
WorkflowWorkflow{..} <- get404 wwId WorkflowWorkflow{..} <- get404 wwId
stIx <- decrypt stCID stIx <- decrypt stCID
payloads <- maybeT notFound . workflowStateSection stIx $ _DBWorkflowState # workflowWorkflowState payloads <- maybeT notFound . workflowStateSection stIx $ _DBWorkflowState # workflowWorkflowState
payloads' <- maybe notFound return . Map.lookup wpl $ workflowStateCurrentPayloads payloads mAuthId <- maybeAuthId
payloads' <- fmap (Map.findWithDefault Set.empty wpl . workflowStateCurrentPayloads) . filterM (mayViewWorkflowAction mAuthId wwId) $ otoList payloads
let let
payloads'' :: [FileReference] payloads'' :: [FileReference]
payloads'' = payloads' ^.. folded . _WorkflowFieldPayloadW . _WorkflowFieldPayload payloads'' = payloads' ^.. folded . _WorkflowFieldPayloadW . _WorkflowFieldPayload

View File

@ -7,6 +7,7 @@ module Model.Types.Workflow
, WorkflowNodeView(..) , WorkflowNodeView(..)
, WorkflowGraphEdgeLabel , WorkflowGraphEdgeLabel
, WorkflowGraphEdge(..) , WorkflowGraphEdge(..)
, WorkflowGraphEdgeAutomaticRestriction(..)
, WorkflowGraphEdgeFormOrder , WorkflowGraphEdgeFormOrder
, WorkflowGraphEdgeForm(..) , WorkflowGraphEdgeForm(..)
, WorkflowRole(..) , WorkflowRole(..)
@ -61,7 +62,6 @@ import Utils.Lens.TH
data WorkflowGraph fileid userid = WorkflowGraph data WorkflowGraph fileid userid = WorkflowGraph
{ wgNodes :: Map WorkflowGraphNodeLabel (WorkflowGraphNode fileid userid) { wgNodes :: Map WorkflowGraphNodeLabel (WorkflowGraphNode fileid userid)
, wgPayloadView :: Map WorkflowPayloadLabel (WorkflowPayloadView userid)
} }
deriving (Generic, Typeable) deriving (Generic, Typeable)
@ -79,6 +79,7 @@ data WorkflowGraphNode fileid userid = WGN
{ wgnFinal :: Bool { wgnFinal :: Bool
, wgnViewers :: Maybe (WorkflowNodeView userid) , wgnViewers :: Maybe (WorkflowNodeView userid)
, wgnEdges :: Map WorkflowGraphEdgeLabel (WorkflowGraphEdge fileid userid) , wgnEdges :: Map WorkflowGraphEdgeLabel (WorkflowGraphEdge fileid userid)
, wgnPayloadView :: Map WorkflowPayloadLabel (WorkflowPayloadView userid)
} }
deriving (Generic, Typeable) deriving (Generic, Typeable)
@ -97,6 +98,11 @@ newtype WorkflowGraphEdgeLabel = WorkflowGraphEdgeLabel { unWorkflowGraphEdgeLab
deriving stock (Eq, Ord, Read, Show, Data, Generic, Typeable) deriving stock (Eq, Ord, Read, Show, Data, Generic, Typeable)
deriving newtype (IsString, ToJSON, ToJSONKey, FromJSON, FromJSONKey, PathPiece, PersistField, PersistFieldSql, Binary) deriving newtype (IsString, ToJSON, ToJSONKey, FromJSON, FromJSONKey, PathPiece, PersistField, PersistFieldSql, Binary)
data WorkflowGraphEdgeAutomaticRestriction
= WorkflowGraphEdgeAutomaticRestrictionPayloadFilled { wgearPayloadFilled :: WorkflowPayloadLabel }
| WorkflowGraphEdgeAutomaticRestrictionPreviousNode { wgearPreviousNode :: WorkflowGraphNodeLabel }
deriving (Eq, Ord, Read, Show, Generic, Typeable)
data WorkflowGraphEdge fileid userid data WorkflowGraphEdge fileid userid
= WorkflowGraphEdgeManual = WorkflowGraphEdgeManual
{ wgeSource :: WorkflowGraphNodeLabel { wgeSource :: WorkflowGraphNodeLabel
@ -106,8 +112,8 @@ data WorkflowGraphEdge fileid userid
, wgeViewActor :: Set (WorkflowRole userid) , wgeViewActor :: Set (WorkflowRole userid)
} }
| WorkflowGraphEdgeAutomatic | WorkflowGraphEdgeAutomatic
{ wgeSource :: WorkflowGraphNodeLabel { wgeSource :: WorkflowGraphNodeLabel
, wgePayloadRestriction :: Maybe (PredDNF WorkflowPayloadLabel) , wgeRestriction :: Maybe (PredDNF WorkflowGraphEdgeAutomaticRestriction)
} }
| WorkflowGraphEdgeInitial | WorkflowGraphEdgeInitial
{ wgeActors :: Set (WorkflowRole userid) { wgeActors :: Set (WorkflowRole userid)
@ -430,8 +436,11 @@ instance Typeable userid => IsWorkflowFieldPayload fileid fileid userid userid'
-- | otherwise -- | otherwise
-- -> traceShow ("none", fieldPayload) mempty -- -> traceShow ("none", fieldPayload) mempty
workflowStateCurrentPayloads :: forall fileid userid. workflowStateCurrentPayloads :: forall fileid userid mono.
WorkflowState fileid userid ( Element mono ~ WorkflowAction fileid userid
, MonoFoldable mono
)
=> mono
-> Map WorkflowPayloadLabel (Set (WorkflowFieldPayloadW fileid userid)) -> Map WorkflowPayloadLabel (Set (WorkflowFieldPayloadW fileid userid))
workflowStateCurrentPayloads = Map.unionsWith (\_ v -> v) . map wpPayload . otoList workflowStateCurrentPayloads = Map.unionsWith (\_ v -> v) . map wpPayload . otoList
@ -596,6 +605,11 @@ deriveToJSON workflowPayloadViewAesonOptions ''WorkflowPayloadView
pathPieceJSON ''WorkflowFieldPayload' pathPieceJSON ''WorkflowFieldPayload'
pathPieceJSON ''WorkflowPayloadField' pathPieceJSON ''WorkflowPayloadField'
deriveJSON defaultOptions
{ fieldLabelModifier = camelToPathPiece' 1
, constructorTagModifier = camelToPathPiece' 5
} ''WorkflowGraphEdgeAutomaticRestriction
instance (FromJSON userid, Ord userid) => FromJSON (WorkflowNodeView userid) where instance (FromJSON userid, Ord userid) => FromJSON (WorkflowNodeView userid) where
parseJSON = genericParseJSON workflowNodeViewAesonOptions parseJSON = genericParseJSON workflowNodeViewAesonOptions
instance (FromJSON userid, Ord userid) => FromJSON (WorkflowPayloadView userid) where instance (FromJSON userid, Ord userid) => FromJSON (WorkflowPayloadView userid) where

View File

@ -1,4 +1,46 @@
$newline never $newline never
$maybe WorkflowCurrentState{..} <- workflowState
<section>
<h2>
_{MsgWorkflowWorkflowWorkflowStateHeading}
<div .workflow-state>
<dl .deflist>
<dt .deflist__dt>
_{MsgWorkflowWorkflowWorkflowStateStateLabel}
<dd .deflist__dd>
$maybe stLbl <- wcsState
#{stLbl}
$nothing
<span .workflow-state--state-special>
_{MsgWorkflowWorkflowWorkflowStateStateHidden}
$if not (onull wcsPayload)
<div .workflow-payload>
<div .workflow-payload--label>
_{MsgWorkflowWorkflowWorkflowPayloadHeading}
<dl .deflist>
$forall (payloadLbl, (newPayload, mFileRoute)) <- wcsPayload
<dt .deflist__dt>
#{payloadLbl}
<dd .deflist__dd>
$if is _Nothing mFileRoute && null newPayload
$else
<ul .list--iconless>
$maybe fileRoute <- mFileRoute
<li>
<a href=@{fileRoute}>
_{MsgWorkflowPayloadFiles}
$forall pItem <- newPayload
<li>
^{payloadToWidget pItem}
$maybe edgeView <- mEdgeView
<section>
<h2>
_{MsgWorkflowWorkflowWorkflowEdgeFormHeading}
^{edgeView}
<section> <section>
<h2> <h2>
_{MsgWorkflowWorkflowWorkflowHistoryHeading} _{MsgWorkflowWorkflowWorkflowHistoryHeading}
@ -6,9 +48,3 @@ $newline never
<ul .workflow-history> <ul .workflow-history>
$forall histItem <- workflowHistory $forall histItem <- workflowHistory
^{historyToWidget histItem} ^{historyToWidget histItem}
$maybe edgeView <- mEdgeView
<section>
<h2>
_{MsgWorkflowWorkflowWorkflowEdgeFormHeading}
^{edgeView}

View File

@ -23,24 +23,37 @@ $newline never
_{MsgWorkflowWorkflowWorkflowHistoryUserAutomatic} _{MsgWorkflowWorkflowWorkflowHistoryUserAutomatic}
<div .workflow-history--item-time> <div .workflow-history--item-time>
^{formatTimeW SelFormatDateTime whiTime} ^{formatTimeW SelFormatDateTime whiTime}
<div .workflow-history--item-action> <div .workflow-history--item-action-states>
$maybe actionLbl <- whiVia <dl .deflist>
#{actionLbl} <dt .deflist__dt>
$nothing _{MsgWorkflowWorkflowWorkflowHistoryActionLabel}
<span .workflow-history--item-action-special> <dd .deflist__dd>
_{MsgWorkflowWorkflowWorkflowHistoryActionAutomatic} $maybe actionLbl <- whiVia
<div .workflow-history--item-states> #{actionLbl}
<div .workflow-history--item-state-from> $nothing
<span .workflow-history--item-action-special>
_{MsgWorkflowWorkflowWorkflowHistoryActionAutomatic}
$maybe mFromLbl <- whiFrom $maybe mFromLbl <- whiFrom
$maybe fromLbl <- mFromLbl <dt .deflist__dt>
#{fromLbl} _{MsgWorkflowWorkflowWorkflowHistoryFromLabel}
<dd .deflist__dd>
$maybe fromLbl <- mFromLbl
#{fromLbl}
$nothing
<span .workflow-history--item-state-special>
_{MsgWorkflowWorkflowWorkflowHistoryStateHidden}
<dt .deflist__dt>
_{MsgWorkflowWorkflowWorkflowHistoryToLabel}
<dd .deflist__dd>
$maybe toLbl <- whiTo
#{toLbl}
$nothing $nothing
<span .workflow-history--item-state-special> <span .workflow-history--item-state-special>
_{MsgWorkflowWorkflowWorkflowHistoryStateHidden} _{MsgWorkflowWorkflowWorkflowHistoryStateHidden}
<div .workflow-history--item-state-to>
#{whiTo}
$if not (onull whiPayloadChanges) $if not (onull whiPayloadChanges)
<div .workflow-history--item-payload-changes> <div .workflow-history--item-payload-changes>
<div .workflow-history--item-payload-changes-label>
_{MsgWorkflowWorkflowWorkflowHistoryPayloadLabel}
<dl .deflist> <dl .deflist>
$forall (payloadLbl, (newPayload, mFileRoute)) <- whiPayloadChanges $forall (payloadLbl, (newPayload, mFileRoute)) <- whiPayloadChanges
<dt .deflist__dt> <dt .deflist__dt>

145
testdata/theses.yaml vendored
View File

@ -15,6 +15,70 @@ nodes:
- &student - &student
tag: payload-reference tag: payload-reference
payload-label: "student" payload-label: "student"
payload-view: &payload-view
"hochschullehrer":
viewers:
- *pruefungsamt
- *hochschullehrer
- *betreuer
- *student
- {"tag": "initiator"}
display-label: "Verantwortliche Hochschullehrer"
"betreuer":
viewers:
- *pruefungsamt
- *hochschullehrer
- *betreuer
- *student
- {"tag": "initiator"}
display-label: "Betreuer"
"student":
viewers:
- *pruefungsamt
- *hochschullehrer
- *betreuer
- *student
- {"tag": "initiator"}
display-label: "Student"
"anmeldetag":
viewers:
- *pruefungsamt
- *hochschullehrer
- *betreuer
- *student
- {"tag": "initiator"}
display-label: "Tag der Anmeldung"
"sprache":
viewers:
- *pruefungsamt
- *hochschullehrer
- *betreuer
- *student
- {"tag": "initiator"}
display-label: "Sprache der Arbeit"
"titel":
viewers:
- *pruefungsamt
- *hochschullehrer
- *betreuer
- *student
- {"tag": "initiator"}
display-label: "Titel, in Sprache der Arbeit"
"titel, englisch":
viewers:
- *pruefungsamt
- *hochschullehrer
- *betreuer
- *student
- {"tag": "initiator"}
display-label: "Titel, Englisch"
"notizen":
viewers:
- *pruefungsamt
- *hochschullehrer
- *betreuer
- {"tag": "initiator"}
display-label: "Notizen"
final: false final: false
edges: edges:
"antrag als pruefungsamt": "antrag als pruefungsamt":
@ -287,6 +351,7 @@ nodes:
- *pruefungsamt - *pruefungsamt
- *hochschullehrer - *hochschullehrer
- *betreuer - *betreuer
payload-view: *payload-view
final: false final: false
edges: edges:
"antrag bestaetigen als hochschullehrer": "antrag bestaetigen als hochschullehrer":
@ -315,6 +380,7 @@ nodes:
- *student - *student
- *hochschullehrer - *hochschullehrer
- *betreuer - *betreuer
payload-view: *payload-view
final: false final: false
edges: edges:
"antrag bestaetigen als student": "antrag bestaetigen als student":
@ -342,6 +408,7 @@ nodes:
- *pruefungsamt - *pruefungsamt
- *hochschullehrer - *hochschullehrer
- *betreuer - *betreuer
payload-view: *payload-view
final: false final: false
edges: edges:
"antrag bestaetigen als student": "antrag bestaetigen als student":
@ -369,12 +436,18 @@ nodes:
- *pruefungsamt - *pruefungsamt
- *hochschullehrer - *hochschullehrer
- *betreuer - *betreuer
payload-view: *payload-view
final: false final: false
edges: edges:
"anmeldetag ist eingetragen": "anmeldetag ist eingetragen":
mode: automatic mode: automatic
source: "antrag, student&hochschullehrer" source: "antrag, student&hochschullehrer"
payload-restriction: { "dnf-terms": [[{"tag": "variable", "var": "anmeldetag"}]] } restriction:
dnf-terms:
- - tag: variable
var:
tag: payload-filled
payload-filled: "anmeldetag"
"angemeldet": "angemeldet":
viewers: viewers:
display-label: "Angemeldet" display-label: "Angemeldet"
@ -383,6 +456,7 @@ nodes:
- *hochschullehrer - *hochschullehrer
- *betreuer - *betreuer
- *student - *student
payload-view: *payload-view
final: false final: false
edges: edges:
"anmelden, bestaetigt student&hochschullehrer, anmeldetag": "anmelden, bestaetigt student&hochschullehrer, anmeldetag":
@ -441,6 +515,7 @@ nodes:
- *hochschullehrer - *hochschullehrer
- *betreuer - *betreuer
- *student - *student
payload-view: *payload-view
final: false final: false
edges: {} edges: {}
"abgegeben": "abgegeben":
@ -451,6 +526,7 @@ nodes:
- *hochschullehrer - *hochschullehrer
- *betreuer - *betreuer
- *student - *student
payload-view: *payload-view
final: false final: false
edges: {} edges: {}
"benotet": "benotet":
@ -461,6 +537,7 @@ nodes:
- *hochschullehrer - *hochschullehrer
- *betreuer - *betreuer
- *student - *student
payload-view: *payload-view
final: false final: false
edges: {} edges: {}
"abgebrochen": "abgebrochen":
@ -471,6 +548,7 @@ nodes:
- *hochschullehrer - *hochschullehrer
- *betreuer - *betreuer
- *student - *student
payload-view: *payload-view
final: false final: false
edges: {} edges: {}
"fertig": "fertig":
@ -478,69 +556,6 @@ nodes:
display-label: "Fertig" display-label: "Fertig"
viewers: viewers:
- *pruefungsamt - *pruefungsamt
payload-view: *payload-view
final: true final: true
edges: {} edges: {}
payload-view:
"hochschullehrer":
viewers:
- *pruefungsamt
- *hochschullehrer
- *betreuer
- *student
- {"tag": "initiator"}
display-label: "Verantwortliche Hochschullehrer"
"betreuer":
viewers:
- *pruefungsamt
- *hochschullehrer
- *betreuer
- *student
- {"tag": "initiator"}
display-label: "Betreuer"
"student":
viewers:
- *pruefungsamt
- *hochschullehrer
- *betreuer
- *student
- {"tag": "initiator"}
display-label: "Student"
"anmeldetag":
viewers:
- *pruefungsamt
- *hochschullehrer
- *betreuer
- *student
- {"tag": "initiator"}
display-label: "Tag der Anmeldung"
"sprache":
viewers:
- *pruefungsamt
- *hochschullehrer
- *betreuer
- *student
- {"tag": "initiator"}
display-label: "Sprache der Arbeit"
"titel":
viewers:
- *pruefungsamt
- *hochschullehrer
- *betreuer
- *student
- {"tag": "initiator"}
display-label: "Titel, in Sprache der Arbeit"
"titel, englisch":
viewers:
- *pruefungsamt
- *hochschullehrer
- *betreuer
- *student
- {"tag": "initiator"}
display-label: "Titel, Englisch"
"notizen":
viewers:
- *pruefungsamt
- *hochschullehrer
- *betreuer
- {"tag": "initiator"}
display-label: "Notizen"