feat(workflows): additional work on WorkflowWorkflowWorkflow

2020-10-26 14:52:58 +01:00 · 2020-10-26 14:52:58 +01:00 · 5108e1494a
commit 5108e1494a
parent fd7c91f5b8
41 changed files with 1677 additions and 393 deletions
--- a/frontend/src/app.sass
+++ b/frontend/src/app.sass
@ -720,7 +720,7 @@ section
     background-color: hsla($hue, 75%, 50%, $opacity) !important


-.uuid, .pseudonym, .ldap-primary-key, .email, .file-path, .metric-value, .metric-label
+.uuid, .pseudonym, .ldap-primary-key, .email, .file-path, .metric-value, .metric-label, .workflow-payload--text
  font-family: var(--font-monospace)

 .token
--- a/frontend/src/utils/form/datepicker.js
+++ b/frontend/src/utils/form/datepicker.js
@ -3,6 +3,8 @@ import './datepicker.css';
 import { Utility } from '../../core/utility';
 import moment from 'moment';

+import * as defer from 'lodash.defer';
+
 const KEYCODE_ESCAPE = 27;
 const Z_INDEX_MODAL = 9999;

@ -77,8 +79,11 @@ export class Datepicker {
  datepickerInstance;
  _element;
  elementType;
+  initialValue;
  _locale;

+  _unloadIsDueToSubmit = false;
+
  constructor(element) {
    if (!element) {
      throw new Error('Datepicker utility needs to be passed an element!');
@ -100,6 +105,9 @@ export class Datepicker {
    // store the previously set type to select the input format
    this.elementType = this._element.getAttribute('type');

+    // store initial value prior to changing type
+    this.initialValue = this._element.value || this._element.getAttribute('value');
+
    // manually set the type attribute to text because datepicker handles displaying the date
    this._element.setAttribute('type', 'text');

@ -120,7 +128,7 @@ export class Datepicker {
    // FIXME dirty hack below; fix tail.datetime instead

    // get date object from internal format before datetime does nasty things with it
-    let parsedMomentDate = moment(this._element.value, [ FORM_DATE_FORMAT[this.elementType], FORM_DATE_FORMAT_MOMENT[this.elementType] ], true);
+    let parsedMomentDate = moment(this.initialValue, [ FORM_DATE_FORMAT[this.elementType], FORM_DATE_FORMAT_MOMENT[this.elementType] ], true);
    if (parsedMomentDate && parsedMomentDate.isValid()) {
      parsedMomentDate = parsedMomentDate.toDate();
    } else {
@ -222,7 +230,9 @@ export class Datepicker {
    });

    // format the date value of the form input element of this datepicker before form submission
-    this._element.form.addEventListener('submit', () => this.formatElementValue());
+    this._element.form.addEventListener('submit', this._submitHandler.bind(this));
+
+    window.addEventListener('beforeunload', this._beforeUnloadHandler.bind(this));
  }

  destroy() {
@ -257,6 +267,33 @@ export class Datepicker {
    }
  }

+  _submitHandler() {
+    this._unloadIsDueToSubmit = true;
+    this.formatElementValue(false);
+
+    defer(() => { // Restore state after event loop is settled
+      this._unloadIsDueToSubmit = false;
+      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.
   * @param {*} toFancy Format date from internal to fancy or vice versa. When omitted, toFancy is falsy and results in fancy -> internal
--- a/frontend/src/utils/form/navigate-away-prompt.js
+++ b/frontend/src/utils/form/navigate-away-prompt.js
@ -5,6 +5,8 @@ import { AUTO_SUBMIT_INPUT_UTIL_SELECTOR } from './auto-submit-input';
 import { InteractiveFieldset } from './interactive-fieldset';
 import { Datepicker } from './datepicker';

+import * as defer from 'lodash.defer';
+
 /**
 * Key generator from an arbitrary number of FormData objects.
 * @param  {...any} formDatas FormData objects
@ -67,6 +69,7 @@ export class NavigateAwayPrompt {

    this._element.addEventListener('submit', () => {
      this._unloadDueToSubmit = true;
+      defer(() => { this._unloadDueToSubmit = false; } ); // Restore state after event loop is settled
    });
  }

--- a/messages/uniworx/de-de-formal.msg
+++ b/messages/uniworx/de-de-formal.msg
@ -527,11 +527,12 @@ UnauthorizedPasswordResetToken: Dieses Authorisierungs-Token kann nicht mehr zum
 UnauthorizedAllocatedCourseRegister: Direkte Anmeldungen zum Kurs sind aufgrund einer Zentralanmeldung aktuell nicht gestattet
 UnauthorizedAllocatedCourseDeregister: Abmeldungen vom Kurs sind aufgrund einer Zentralanmeldung aktuell nicht gestattet
 UnauthorizedAllocatedCourseDelete: Kurse, die an einer Zentralanmeldung teilnehmen, dürfen nicht gelöscht werden
-UnauthorizedWorkflowInitiate: Der Workflow darf nicht im angegebenen Zustand unter Verwendung der angegebenen Kante initiiert werden
+UnauthorizedWorkflowInitiate: Sie dürfen keinen neuen laufenden Workflow initiieren
 UnauthorizedWorkflowWrite: Sie dürfen aktuell keinen Zustandsübergang im Workflow auslösen
 UnauthorizedWorkflowRead: Der Workflow enthält aktuell keine Zustände oder Daten die Sie einsehen dürfen
 UnauthorizedWorkflowInstancesNotEmpty: Es gibt Workflow Instanzen für die Sie einen neuen laufenden Workflow initiieren dürfen
 UnauthorizedWorkflowWorkflowsNotEmpty: Es gibt laufende Workflows, die Sie einsehen dürfen
+UnauthorizedWorkflowFiles: Sie dürfen die angegebenen Workflow-Dateien nicht im angegebenen historischen Zustand herunterladen

 WorkflowRoleUserMismatch: Sie sind nicht einer der vom Workflow geforderten Benutzer
 WorkflowRoleAlreadyInitiated: Dieser Workflow wurde bereits initiiert
@ -1501,6 +1502,7 @@ BreadcrumbWorkflowInstanceInitiate: Workflow starten
 BreadcrumbWorkflowInstanceList: Workflows
 BreadcrumbWorkflowInstanceNew: Neuer Workflow
 BreadcrumbWorkflowWorkflow workflow@CryptoFileNameWorkflowWorkflow: #{toPathPiece workflow}
+BreadcrumbWorkflowWorkflowFiles: Dateien
 BreadcrumbWorkflowWorkflowEdit: Editieren
 BreadcrumbWorkflowWorkflowDelete: Löschen
 BreadcrumbGlobalWorkflowInstanceList: Workflows
@ -2951,6 +2953,8 @@ WorkflowDefinitionCollision: Es existiert bereits eine Workflow-Definition mit d
 WorkflowDefinitionNewTitle: Workflow-Definition anlegen
 WorkflowDefinitionEditTitle: Workflow-Definition Bearbeiten
 WorkflowDefinitionInstanceCategory: Kategorie
+WorkflowDefinitionWarningLinterIssuesMessage: Es sind Linter issues aufgetreten
+WorkflowDefinitionWarningLinterIssues: Es sind folgende Linter issues aufgetreten:

 WorkflowDefinitionListTitle: Workflow-Definitionen
 WorkflowDefinitionInstanceCount: Instanzen
@ -2995,6 +2999,27 @@ WorkflowEdgeFormFieldNumberTooSmall minSci@Scientific: Zahl muss mindestens #{fo
 WorkflowEdgeFormFieldNumberTooLarge maxSci@Scientific: Zahl muss höchstens #{formatScientific Scientific.Generic Nothing maxSci} sein
 WorkflowEdgeFormFieldUserNotFound: E-Mail Adresse konnte keinem Benutzer zugeordnet werden
 WorkflowEdgeFormFieldMultipleNoneAdded: (Noch) keine Einträge
+WorkflowEdgeFormFieldCaptureUserLabel: Aktueller Benutzer
+
+WorkflowWorkflowWorkflowHistoryHeading: Verlauf
+WorkflowWorkflowWorkflowEdgeFormHeading: Aktion im Workflow auslösen
+WorkflowWorkflowWorkflowEdgeSuccess: Aktion erfolgreich ausgelöst
+WorkflowWorkflowWorkflowHistoryUserSelf: Sie selbst
+WorkflowWorkflowWorkflowHistoryUserNotLoggedIn: Nicht eingeloggter Benutzer
+WorkflowWorkflowWorkflowHistoryUserGone: Gelöschter Benutzer
+WorkflowWorkflowWorkflowHistoryUserHidden: Versteckter Benutzer
+WorkflowWorkflowWorkflowHistoryUserAutomatic: Automatisch
+WorkflowWorkflowWorkflowHistoryActionAutomatic: Automatisch
+WorkflowWorkflowWorkflowHistoryStateHidden: Versteckter Zustand
+WorkflowWorkflowFilesArchiveName wwCID@CryptoFileNameWorkflowWorkflow wpl@WorkflowPayloadLabel stCID@CryptoUUIDWorkflowStateIndex: #{foldCase (toPathPiece wwCID)}-#{foldCase (toPathPiece stCID)}-#{foldCase (foldMap unidecode (toPathPiece wpl))}.zip
+
+WorkflowPayloadFiles: Datei(en)
+WorkflowPayloadBoolTrue: Ja
+WorkflowPayloadBoolFalse: Nein
+WorkflowPayloadUserGone: Gelöschter Benutzer
+
+GlobalWorkflowWorkflowWorkflowHeading workflowWorkflowId@CryptoFileNameWorkflowWorkflow: Workflow #{toPathPiece workflowWorkflowId}
+GlobalWorkflowWorkflowWorkflowTitle workflowWorkflowId@CryptoFileNameWorkflowWorkflow: Workflow #{toPathPiece workflowWorkflowId}

 ChangelogItemFeature: Feature
 ChangelogItemBugfix: Bugfix
--- a/1
+++ b/1
@ -79,6 +79,7 @@
 /workflows                    GlobalWorkflowWorkflowListR GET  !¬empty
 /workflows/#CryptoFileNameWorkflowWorkflow GlobalWorkflowWorkflowR:
  /                           GWWWorkflowR     GET POST        !workflow
+  /files/#WorkflowPayloadLabel/#CryptoUUIDWorkflowStateIndex GWWFilesR GET !workflow
  /edit                       GWWEditR         GET POST
  /delete                     GWWDeleteR       GET POST

--- a/src/CryptoID.hs
+++ b/src/CryptoID.hs
@ -77,6 +77,9 @@ decCryptoIDs [ ''SubmissionId
             , ''WorkflowWorkflowId
             ]

+type instance CryptoIDNamespace a WorkflowStateIndex = "WorkflowStateIndex"
+type CryptoUUIDWorkflowStateIndex = CryptoUUID WorkflowStateIndex
+
 decCryptoIDKeySize

 -- CryptoIDNamespace (CI FilePath) SubmissionId ~ "Submission"
--- a/src/Foundation/Authorization.hs
+++ b/src/Foundation/Authorization.hs
@ -1224,6 +1224,8 @@ tagAccessPredicate AuthEmpty = APDB $ \mAuthId route _ -> do
        return Authorized

  case route of
+    _ | Just (rScope, WorkflowInstanceListR) <- route ^? _WorkflowScopeRoute -> wInstances rScope
+    _ | Just (rScope, WorkflowWorkflowListR) <- route ^? _WorkflowScopeRoute -> wWorkflows rScope
    EExamListR -> exceptT return return $ do
      authId <- maybeExceptT AuthenticationRequired $ return mAuthId
      hasExternalExams <- $cachedHereBinary authId . lift . E.selectExists . E.from $ \(eexam `E.InnerJoin` eexamStaff) -> do
@ -1243,8 +1245,6 @@ tagAccessPredicate AuthEmpty = APDB $ \mAuthId route _ -> do
        E.on $ sheet E.^. SheetId E.==. submission E.^. SubmissionSheet
        E.where_ $ sheet E.^. SheetCourse E.==. E.val cid
      return Authorized
-    GlobalWorkflowInstanceListR -> wInstances WSGlobal
-    GlobalWorkflowWorkflowListR -> wWorkflows WSGlobal
    r -> $unsupportedAuthPredicate AuthEmpty r
 tagAccessPredicate AuthMaterials = APDB $ \_ route _ -> case route of
  CourseR tid ssh csh _ -> maybeT (unauthorizedI MsgUnfreeMaterials) $ do
@ -1364,7 +1364,8 @@ tagAccessPredicate AuthWorkflow = APDB $ \mAuthId route isWrite -> do
      orAR' = shortCircuitM (is _Authorized) (orAR mr)
      _andAR' = shortCircuitM (is _Unauthorized) (andAR mr)
    
-      wInitiate win scope = maybeT (unauthorizedI MsgUnauthorizedWorkflowInitiate) $ do
+      wInitiate win rScope = maybeT (unauthorizedI MsgUnauthorizedWorkflowInitiate) $ do
+        scope <- MaybeT . $cachedHereBinary rScope . runMaybeT $ fromRouteWorkflowScope rScope
        Entity _ WorkflowInstance{..} <- $cachedHereBinary (win, scope) . MaybeT . getBy . UniqueWorkflowInstance win $ scope ^. _DBWorkflowScope
        let
          wiGraph :: WorkflowGraph FileReference UserId
@ -1376,11 +1377,12 @@ tagAccessPredicate AuthWorkflow = APDB $ \mAuthId route isWrite -> do
        let
          evalRole role = lift $ evalWorkflowRoleFor mAuthId Nothing role route isWrite
          checkEdge actors = ofoldr1 orAR' (mapNonNull evalRole actors)
-        ofoldr1 orAR' . mapNonNull checkEdge =<< hoistMaybe (fromNullable edges)
+        guardM . fmap (is _Authorized) $ ofoldr1 orAR' . mapNonNull checkEdge =<< hoistMaybe (fromNullable edges)
+        return Authorized

      wWorkflow isWrite' cID
        | isWrite' = maybeT (unauthorizedI MsgUnauthorizedWorkflowWrite) $ do
-            wwId <- decrypt cID
+            wwId <- catchIfMaybeT (const True :: CryptoIDError -> Bool) $ decrypt cID
            WorkflowWorkflow{..} <- MaybeT . $cachedHereBinary wwId $ get wwId

            let
@ -1397,9 +1399,10 @@ tagAccessPredicate AuthWorkflow = APDB $ \mAuthId route isWrite -> do

              evalRole role = lift $ evalWorkflowRoleFor mAuthId (Just wwId) role route isWrite
              checkEdge actors = ofoldr1 orAR' (mapNonNull evalRole actors)
-            ofoldr1 orAR' . mapNonNull checkEdge =<< hoistMaybe (fromNullable edges)
+            guardM . fmap (is _Authorized) $ ofoldr1 orAR' . mapNonNull checkEdge =<< hoistMaybe (fromNullable edges)
+            return Authorized
        | otherwise = flip orAR' (wWorkflow True cID) . maybeT (unauthorizedI MsgUnauthorizedWorkflowRead) $ do
-            wwId <- decrypt cID
+            wwId <- catchIfMaybeT (const True :: CryptoIDError -> Bool) $ decrypt cID
            WorkflowWorkflow{..} <- MaybeT . $cachedHereBinary wwId $ get wwId

            let
@ -1410,18 +1413,36 @@ tagAccessPredicate AuthWorkflow = APDB $ \mAuthId route isWrite -> do
                WorkflowAction{..} <- otoList workflowWorkflowState
                (node, WGN{..}) <- itoListOf (_wgNodes . ifolded) wwGraph
                guard $ node == wpTo
-                return wgnViewers
+                WorkflowNodeView{..} <- hoistMaybe wgnViewers
+                return $ toNullable wnvViewers
              payloadViewers = do
                WorkflowAction{..} <- otoList workflowWorkflowState
                payload <- Map.keys wpPayload
                fmap (toNullable . wpvViewers) . hoistMaybe $ wgPayloadView wwGraph Map.!? payload
              
              evalRole role = lift $ evalWorkflowRoleFor mAuthId (Just wwId) role route isWrite
-            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)
+            return Authorized
+      wFiles wwCID wpl stCID = maybeT (unauthorizedI MsgUnauthorizedWorkflowFiles) $ do
+        wwId <- catchIfMaybeT (const True :: CryptoIDError -> Bool) $ decrypt wwCID
+        WorkflowWorkflow{..} <- MaybeT . $cachedHereBinary wwId $ get wwId
+        stIx <- catchIfMaybeT (const True :: CryptoIDError -> Bool) $ decryptWorkflowStateIndex wwId stCID
+        let
+          wwGraph :: WorkflowGraph FileReference UserId
+          wwGraph = workflowWorkflowGraph & over (typesCustom @WorkflowChildren) (review _SqlKey :: SqlBackendKey -> UserId)
+
+          payloadViewers = Map.findWithDefault Set.empty wpl $ toNullable . wpvViewers <$> wgPayloadView wwGraph
+          evalRole role = lift $ evalWorkflowRoleFor mAuthId (Just wwId) role route isWrite
+        guardM . anyM (otoList payloadViewers) $ fmap (is _Authorized) . evalRole
+        WorkflowAction{wpTo} <- workflowStateIndex stIx workflowWorkflowState 
+        WorkflowNodeView{wnvViewers} <- hoistMaybe $ wgnViewers =<< wgNodes wwGraph Map.!? wpTo
+        guardM . anyM (otoList wnvViewers) $ fmap (is _Authorized) . evalRole
+        return Authorized

  case route of
-    GlobalWorkflowInstanceR win GWIInitiateR -> wInitiate win WSGlobal
-    GlobalWorkflowWorkflowR cID GWWWorkflowR -> wWorkflow isWrite cID
+    _ | Just (rScope, WorkflowInstanceR win WIInitiateR) <- route ^? _WorkflowScopeRoute -> wInitiate win rScope
+    _ | Just (_, WorkflowWorkflowR cID WWWorkflowR) <- route ^? _WorkflowScopeRoute -> wWorkflow isWrite cID
+    _ | Just (_, WorkflowWorkflowR wwCID (WWFilesR wpl stCID)) <- route ^? _WorkflowScopeRoute -> wFiles wwCID wpl stCID
    r -> $unsupportedAuthPredicate AuthWorkflow r
 tagAccessPredicate AuthRead = APPure $ \_ _ isWrite -> do
  MsgRenderer mr <- ask
@ -1625,7 +1646,7 @@ evalWorkflowRoleFor' tagActive mAuthId mwwId wRole route isWrite = $cachedHereBi
    uid <- maybeExceptT AuthenticationRequired $ return mAuthId
    wwId <- maybeMExceptT (unauthorizedI MsgWorkflowRoleNoPayload) $ return mwwId
    WorkflowWorkflow{..} <- maybeMExceptT (unauthorizedI MsgWorkflowRoleNoSuchWorkflowWorkflow) . lift . withReaderT (projectBackend @SqlReadBackend) $ get wwId
-    let uids = maybe Set.empty getLast . foldMap (fmap Last . assertM' (not . Set.null)) . workflowStatePayload workflowRolePayloadLabel $ _DBWorkflowState # workflowWorkflowState
+    let uids = maybe Set.empty getLast . foldMap (fmap Last) . workflowStatePayload workflowRolePayloadLabel $ _DBWorkflowState # workflowWorkflowState
    unless (uid `Set.member` uids) $ 
      throwE =<< unauthorizedI MsgWorkflowRoleUserMismatch
    return Authorized
--- a/src/Foundation/I18n.hs
+++ b/src/Foundation/I18n.hs
@ -15,6 +15,7 @@ module Foundation.I18n
  , ShortStudyFieldType(..)
  , StudyDegreeTermType(..)
  , ErrorResponseTitle(..)
+  , WorkflowPayloadBool(..)
  , UniWorXMessages(..)
  , uniworxMessages
  , unRenderMessage, unRenderMessage', unRenderMessageLenient
@ -348,6 +349,10 @@ instance HasResolution a => ToMessage (Fixed a) where
 newtype ErrorResponseTitle = ErrorResponseTitle ErrorResponse
 embedRenderMessageVariant ''UniWorX ''ErrorResponseTitle ("ErrorResponseTitle" <>)

+newtype WorkflowPayloadBool = WorkflowPayloadBool { unWorkflowPayloadBool :: Bool }
+embedRenderMessageVariant ''UniWorX ''WorkflowPayloadBool ("WorkflowPayloadBool" <>)
+
+
 newtype UniWorXMessages = UniWorXMessages [SomeMessage UniWorX]
  deriving stock (Generic, Typeable)
  deriving newtype (Semigroup, Monoid)
--- a/src/Foundation/Navigation.hs
+++ b/src/Foundation/Navigation.hs
@ -359,6 +359,7 @@ instance BearerAuthSite UniWorX => YesodBreadcrumbs UniWorX where
  breadcrumb GlobalWorkflowWorkflowListR = i18nCrumb MsgBreadcrumbGlobalWorkflowWorkflowList $ Just GlobalWorkflowInstanceListR
  breadcrumb (GlobalWorkflowWorkflowR cID sRoute) = case sRoute of
    GWWWorkflowR -> i18nCrumb (MsgBreadcrumbWorkflowWorkflow cID) $ Just GlobalWorkflowInstanceListR
+    GWWFilesR _ _ -> i18nCrumb MsgBreadcrumbWorkflowWorkflowFiles . Just $ GlobalWorkflowWorkflowR cID GWWWorkflowR
    GWWEditR -> i18nCrumb MsgBreadcrumbWorkflowWorkflowEdit . Just $ GlobalWorkflowWorkflowR cID GWWWorkflowR
    GWWDeleteR -> i18nCrumb MsgBreadcrumbWorkflowWorkflowDelete . Just $ GlobalWorkflowWorkflowR cID GWWWorkflowR

--- a/src/Foundation/Yesod/Middleware.hs
+++ b/src/Foundation/Yesod/Middleware.hs
@ -23,6 +23,8 @@ import Control.Monad.Writer.Class (MonadWriter(..))

 import Yesod.Core.Types (GHState(..), HandlerData(..), RunHandlerEnv(rheSite, rheChild))

+import qualified Data.Map as Map
+

 yesodMiddleware :: ( BearerAuthSite UniWorX
                   , BackendCompatible SqlReadBackend (YesodPersistBackend UniWorX)
@ -160,6 +162,7 @@ routeNormalizers = map (hoist (hoist liftHandler . withReaderT projectBackend) .
  , ncExternalExam
  , ncAdminWorkflowDefinition
  , ncWorkflowInstance
+  , ncWorkflowPayloadLabel
  , verifySubmission
  , verifyCourseApplication
  , verifyCourseNews
@ -250,6 +253,14 @@ routeNormalizers = map (hoist (hoist liftHandler . withReaderT projectBackend) .
      caseChanged win workflowInstanceName
      return $ route
        & typesUsing @RouteChildren @WorkflowInstanceName . filtered (== win) .~ workflowInstanceName
+    ncWorkflowPayloadLabel = maybeOrig $ \route -> do
+      (_, WorkflowWorkflowR cID (WWFilesR wpl _)) <- hoistMaybe $ route ^? _WorkflowScopeRoute
+      wwId <- decrypt cID
+      WorkflowWorkflow{..} <- MaybeT . $cachedHereBinary wwId . lift $ get wwId
+      [wpl'] <- return . filter (== wpl) . Map.keys $ wgPayloadView workflowWorkflowGraph
+      (caseChanged `on` unWorkflowPayloadLabel) wpl wpl'
+      return $ route
+        & typesUsing @RouteChildren @WorkflowPayloadLabel . filtered (== wpl) .~ wpl'
    verifySubmission = maybeOrig $ \route -> do
      CSubmissionR _tid _ssh _csh _shn cID sr <- return route
      sId <- $cachedHereBinary cID $ decrypt cID
--- a/src/Handler/Utils/Workflow/CanonicalRoute.hs
+++ b/src/Handler/Utils/Workflow/CanonicalRoute.hs
@ -18,7 +18,7 @@ data WorkflowInstanceR
  deriving (Eq, Ord, Read, Show, Generic, Typeable)

 data WorkflowWorkflowR
-  = WWWorkflowR | WWEditR | WWDeleteR
+  = WWWorkflowR | WWFilesR WorkflowPayloadLabel CryptoUUIDWorkflowStateIndex | WWEditR | WWDeleteR
  deriving (Eq, Ord, Read, Show, Generic, Typeable)


@ -31,30 +31,32 @@ _WorkflowScopeRoute = prism' (uncurry toRoute) toWorkflowScopeRoute
  where
    toRoute = \case
      WSGlobal -> \case
-        WorkflowInstanceListR          -> GlobalWorkflowInstanceListR
-        WorkflowInstanceNewR           -> GlobalWorkflowInstanceNewR
-        WorkflowInstanceR win subRoute -> GlobalWorkflowInstanceR win $ case subRoute of
+        WorkflowInstanceListR            -> GlobalWorkflowInstanceListR
+        WorkflowInstanceNewR             -> GlobalWorkflowInstanceNewR
+        WorkflowInstanceR win subRoute   -> GlobalWorkflowInstanceR win $ case subRoute of
          WIEditR      -> GWIEditR
          WIDeleteR    -> GWIDeleteR
          WIWorkflowsR -> GWIWorkflowsR
          WIInitiateR  -> GWIInitiateR
-        WorkflowWorkflowListR          -> GlobalWorkflowWorkflowListR
-        WorkflowWorkflowR cID subRoute -> GlobalWorkflowWorkflowR cID $ case subRoute of
-          WWWorkflowR -> GWWWorkflowR
-          WWEditR     -> GWWEditR
-          WWDeleteR   -> GWWDeleteR
+        WorkflowWorkflowListR            -> GlobalWorkflowWorkflowListR
+        WorkflowWorkflowR wwCID subRoute -> GlobalWorkflowWorkflowR wwCID $ case subRoute of
+          WWWorkflowR        -> GWWWorkflowR
+          WWFilesR wpl stCID -> GWWFilesR wpl stCID
+          WWEditR            -> GWWEditR
+          WWDeleteR          -> GWWDeleteR
      other -> error $ "not implemented _WorkflowScopeRoute for: " <> show other
    toWorkflowScopeRoute = \case
-      GlobalWorkflowInstanceListR          -> Just ( WSGlobal, WorkflowInstanceListR )
-      GlobalWorkflowInstanceNewR           -> Just ( WSGlobal, WorkflowInstanceNewR )
-      GlobalWorkflowInstanceR win subRoute -> Just . (WSGlobal, ) . WorkflowInstanceR win $ case subRoute of
+      GlobalWorkflowInstanceListR            -> Just ( WSGlobal, WorkflowInstanceListR )
+      GlobalWorkflowInstanceNewR             -> Just ( WSGlobal, WorkflowInstanceNewR )
+      GlobalWorkflowInstanceR win subRoute   -> Just . (WSGlobal, ) . WorkflowInstanceR win $ case subRoute of
        GWIEditR      -> WIEditR
        GWIDeleteR    -> WIDeleteR
        GWIWorkflowsR -> WIWorkflowsR
        GWIInitiateR  -> WIInitiateR
-      GlobalWorkflowWorkflowListR          -> Just ( WSGlobal, WorkflowWorkflowListR )
-      GlobalWorkflowWorkflowR cID subRoute -> Just . (WSGlobal, ) . WorkflowWorkflowR cID $ case subRoute of
-        GWWWorkflowR -> WWWorkflowR
-        GWWEditR     -> WWEditR
-        GWWDeleteR   -> WWDeleteR
+      GlobalWorkflowWorkflowListR            -> Just ( WSGlobal, WorkflowWorkflowListR )
+      GlobalWorkflowWorkflowR wwCID subRoute -> Just . (WSGlobal, ) . WorkflowWorkflowR wwCID $ case subRoute of
+        GWWWorkflowR        -> WWWorkflowR
+        GWWFilesR wpl stCID -> WWFilesR wpl stCID
+        GWWEditR            -> WWEditR
+        GWWDeleteR          -> WWDeleteR
      _other -> Nothing
--- a/src/Handler/Utils/Workflow/EdgeForm.hs
+++ b/src/Handler/Utils/Workflow/EdgeForm.hs
@ -10,6 +10,7 @@ import Utils.Form
 import Utils.Workflow
 import Handler.Utils.Form
 import Handler.Utils.Workflow.CanonicalRoute
+import Handler.Utils.Widgets

 import qualified ListT

@ -36,6 +37,7 @@ import Control.Monad.Trans.RWS.Strict (RWST, evalRWST)
 import Data.Bitraversable

 import Data.List (findIndex)
+import qualified Data.List as List (delete)

 import qualified Data.Aeson as Aeson
 import qualified Data.Scientific as Scientific
@ -107,6 +109,8 @@ workflowEdgeForm mwwId mPrev = runMaybeT $ do
        return (wgeDisplayLabel, wgeForm)
      _other -> mzero

+  guard . not $ null edges
+
  -- edgesOptList :: OptionList (WorkflowGraphNodeLabel, WorkflowGraphEdgeLabel)
  edgesOptList <- do
    sBoxKey <- secretBoxKey
@ -124,7 +128,7 @@ workflowEdgeForm mwwId mPrev = runMaybeT $ do
    let olOptions = concat $ do
          let optSort = (compareUnicode `on` (Text.toLower . optionDisplay))
                     <>  comparing (fallbackSortKey . optionInternalValue)
-                where fallbackSortKey = toDigest . kmaclazy ("workflow-edge-sorting" :: ByteString) (Saltine.encode sBoxKey) . Binary.encode
+                where fallbackSortKey = toDigest . kmaclazy ("workflow-edge-sorting" :: ByteString) (Saltine.encode sBoxKey) . Binary.encode . (mwwId, )
                        where toDigest :: Crypto.KMAC (SHAKE256 256) -> ByteString
                              toDigest = BA.convert
          opts <- sortBy optSort olOptions'
@ -156,7 +160,7 @@ workflowEdgeForm mwwId mPrev = runMaybeT $ do
              payloadSpec' <- traverseOf (typesCustom @WorkflowChildren @(WorkflowPayloadSpec FileReference UserId) @(WorkflowPayloadSpec FileReference CryptoUUIDUser) @UserId @CryptoUUIDUser) encrypt payloadSpec
              let toDigest :: Crypto.KMAC (SHAKE256 256) -> ByteString
                  toDigest = BA.convert
-                  fallbackSortKey = toDigest . kmaclazy ("workflow-edge-form-payload-field-sorting" :: ByteString) (Saltine.encode sBoxKey) $ Aeson.encode payloadSpec'
+                  fallbackSortKey = toDigest . kmaclazy ("workflow-edge-form-payload-field-sorting" :: ByteString) (Saltine.encode sBoxKey) $ Aeson.encode (mwwId, payloadSpec')
              return (Right fallbackSortKey, payloadSpec)
              
        orderedFields' <- flip evalStateT 1 . for orderedFields $ \x@(payloadLabel, _) -> do
@ -187,9 +191,9 @@ workflowEdgeForm mwwId mPrev = runMaybeT $ do

        fields' <-
          let payloadReferenceAdjacency = fieldsMap <&> setOf (_2 . _1 . folded . _Left)
-              fieldsMap :: Map WorkflowPayloadLabel ((Text, Bool), ([Either WorkflowPayloadLabel (Bool, FormResult (Maybe (WorkflowFieldPayloadW FileReference UserId)))], [FieldView UniWorX]))
+              fieldsMap :: Map WorkflowPayloadLabel ((Text, Bool), ([Either WorkflowPayloadLabel (Bool, FormResult (Maybe (NonEmpty (WorkflowFieldPayloadW FileReference UserId))))], [FieldView UniWorX]))
              fieldsMap = Map.fromList fields
-              resolveReferences :: forall i. Topograph.G WorkflowPayloadLabel i -> [(WorkflowPayloadLabel, ((Text, Bool), ([(Bool, FormResult (Maybe (WorkflowFieldPayloadW FileReference UserId)))], [FieldView UniWorX])))]
+              resolveReferences :: forall i. Topograph.G WorkflowPayloadLabel i -> [(WorkflowPayloadLabel, ((Text, Bool), ([(Bool, FormResult (Maybe (NonEmpty (WorkflowFieldPayloadW FileReference UserId))))], [FieldView UniWorX])))]
              resolveReferences Topograph.G{gVertices, gFromVertex} = resort . Map.toList . flip execState Map.empty . for topoOrder $ \payloadLabel -> whenIsJust (Map.lookup payloadLabel fieldsMap) $ \(payloadDisplay, (payloadRes, payloadFieldViews)) -> State.modify' $ \oldState ->
                let payloadRes' = flip concatMap payloadRes $ \case
                      Right res -> pure res
@ -202,7 +206,7 @@ workflowEdgeForm mwwId mPrev = runMaybeT $ do

        fmap Map.fromList . for fields' $ \(payloadLabel, ((payloadDisplayLabel, isOptional), (payloadRes, payloadFieldViews))) -> (payloadLabel, ) <$> do
          $logWarnS "WorkflowEdgeForm" $ toPathPiece payloadLabel <> ": " <> tshow payloadRes
-          let payloadRes' = let res = foldMap (views _2 . fmap $ maybe Set.empty Set.singleton) payloadRes
+          let payloadRes' = let res = foldMap (views _2 . fmap $ maybe Set.empty (Set.fromList . otoList)) payloadRes
                             in if | doErrMsg -> FormFailure $ view _FormFailure res ++ pure (mr $ MsgWorkflowEdgeFormPayloadOneFieldRequiredFor payloadDisplayLabel)
                                   | otherwise -> res
              doErrMsg = flip none payloadRes $ \res -> view _1 res || hasn't (_2 . _FormSuccess) res
@ -235,25 +239,52 @@ workflowEdgeForm mwwId mPrev = runMaybeT $ do

 workflowEdgePayloadFields :: [WorkflowPayloadSpec FileReference UserId]
                          -> Maybe [WorkflowFieldPayloadW FileReference UserId]
-                          -> WForm Handler ([Either WorkflowPayloadLabel (Bool, FormResult (Maybe (WorkflowFieldPayloadW FileReference UserId)))], All) -- ^ @isFilled@, @foldMap ala All . map isOptional@
+                          -> WForm Handler ([Either WorkflowPayloadLabel (Bool, FormResult (Maybe (NonEmpty (WorkflowFieldPayloadW FileReference UserId))))], All) -- ^ @isFilled@, @foldMap ala All . map isOptional@
 workflowEdgePayloadFields specs = evalRWST (forM specs $ runExceptT . renderSpecField) Nothing . fromMaybe []
  where
    renderSpecField :: WorkflowPayloadSpec FileReference UserId
-                    -> ExceptT WorkflowPayloadLabel (RWST (Maybe (Text -> Text)) All [WorkflowFieldPayloadW FileReference UserId] (MForm (WriterT [FieldView UniWorX] Handler))) (Bool, FormResult (Maybe (WorkflowFieldPayloadW FileReference UserId)))
+                    -> ExceptT WorkflowPayloadLabel (RWST (Maybe (Text -> Text)) All [WorkflowFieldPayloadW FileReference UserId] (MForm (WriterT [FieldView UniWorX] Handler))) (Bool, FormResult (Maybe (NonEmpty (WorkflowFieldPayloadW FileReference UserId))))
    renderSpecField (WorkflowPayloadSpec (specField :: WorkflowPayloadField FileReference UserId payload)) = do
-      let f isOpt fld fs mx = lift . (<* tell (All isOpt)) . lift $ over (_2 . mapped . mapped) (review $ _WorkflowFieldPayloadW . _WorkflowFieldPayload) . bool (is (_FormSuccess . _Just) &&& id) (True, ) isOpt <$> wopt fld fs (Just <$> mx)
+      let f' :: forall payload' payload''.
+               _
+             => (payload' -> Maybe (NonEmpty payload''))
+             -> Bool -- ^ @isOpt@
+             -> Field Handler payload'
+             -> FieldSettings UniWorX
+             -> Maybe payload'
+             -> _ ((Bool, FormResult (Maybe (NonEmpty (WorkflowFieldPayloadW FileReference UserId)))))
+          f' toNonEmpty' isOpt fld fs mx = lift . (<* tell (All isOpt)) . lift $ over (_2 . mapped) (fmap (fmap . review $ _WorkflowFieldPayloadW . _WorkflowFieldPayload) . toNonEmpty' =<<) . bool (is (_FormSuccess . _Just) &&& id) (True, ) isOpt <$> wopt fld fs (Just <$> mx)
+          f :: forall payload'.
+               _
+            => Bool -- ^ @isOpt@
+            -> Field Handler payload'
+            -> FieldSettings UniWorX
+            -> Maybe payload'
+            -> _ ((Bool, FormResult (Maybe (NonEmpty (WorkflowFieldPayloadW FileReference UserId)))))
+          f = f' (nonEmpty . pure)
+          extractPrevs :: forall payload' m xs.
+                          ( IsWorkflowFieldPayload' FileReference UserId payload'
+                          , State.MonadState [WorkflowFieldPayloadW FileReference UserId] m
+                          )
+                       => (payload' -> Maybe xs -> Maybe xs)
+                       -> m (Maybe xs)
+          extractPrevs accum = State.state $ foldl' go (Nothing, []) . map (matching $ _WorkflowFieldPayloadW @payload' @FileReference @UserId . _WorkflowFieldPayload)
+            where go (mPrev', xs) (Left  x) = (mPrev', xs ++ [x])
+                  go (acc,    xs) (Right p) = case accum p acc of
+                    acc'@(Just _) -> (acc', xs)
+                    Nothing -> (acc, xs ++ [_WorkflowFieldPayloadW @payload' @FileReference @UserId . _WorkflowFieldPayload # p])
          extractPrev :: forall payload' m.
-                         ( IsWorkflowFieldPayload FileReference UserId payload'
+                         ( IsWorkflowFieldPayload' FileReference UserId payload'
                         , State.MonadState [WorkflowFieldPayloadW FileReference UserId] m
                         )
                      => m (Maybe payload')
-          extractPrev = State.state $ foldl' go (Nothing, []) . map (matching $ _WorkflowFieldPayloadW . _WorkflowFieldPayload)
-            where go (mPrev' , xs) (Left  x ) = (mPrev', xs ++ [x])
-                  go (Nothing, xs) (Right p ) = (Just p, xs)
-                  go (Just p , xs) (Right p') = (Just p, xs ++ [_WorkflowFieldPayloadW . _WorkflowFieldPayload # p'])
+          extractPrev = extractPrevs $ \p -> \case
+            Nothing -> Just p
+            Just _  -> Nothing
          wSetTooltip' :: _ => Maybe Html -> t' (t (MForm (WriterT [FieldView UniWorX] Handler))) a -> t' (t (MForm (WriterT [FieldView UniWorX] Handler))) a
          wSetTooltip' tip = hoist (hoist (wSetTooltip tip))

+      MsgRenderer mr <- getMsgRenderer
      LanguageSelectI18n{..} <- getLanguageSelectI18n
      mNudge <- ask

@ -262,7 +293,7 @@ workflowEdgePayloadFields specs = evalRWST (forM specs $ runExceptT . renderSpec
          prev <- extractPrev @Text
          wSetTooltip' (fmap slI18n wpftTooltip) $
            f wpftOptional
-              (textField & cfStrip)
+              (bool (textField & cfStrip) (textareaField & isoField _Wrapped & cfStrip) wpftLarge)
              ( fsl (slI18n wpftLabel)
                  & maybe id (addPlaceholder . slI18n) wpftPlaceholder
                  & maybe id (addName . ($ "text")) mNudge
@ -294,10 +325,23 @@ workflowEdgePayloadFields specs = evalRWST (forM specs $ runExceptT . renderSpec
                  & maybe id (addName . ($ "bool")) mNudge
              )
              (prev <|> wpfbDefault)
+        WorkflowPayloadFieldDay{..} -> do
+          prev <- extractPrev @Day
+          wSetTooltip' (fmap slI18n wpfdTooltip) $
+            f wpfdOptional
+               dayField
+              ( fsl (slI18n wpfdLabel)
+                  & maybe id (addName . ($ "day")) mNudge
+              )
+              (prev <|> wpfdDefault)
        WorkflowPayloadFieldFile{..} -> do
-          fRefs <- extractPrev @(Set FileReference)
+          fRefs <- extractPrevs @FileReference $ \p -> if
+            | fieldMultiple wpffConfig -> Just . maybe (Set.singleton p) (Set.insert p)
+            | otherwise -> \case
+                Nothing -> Just $ Set.singleton p
+                Just _  -> Nothing
          wSetTooltip' (fmap slI18n wpffTooltip) $
-            f wpffOptional
+            f' (nonEmpty . Set.toList) wpffOptional
              (convertFieldM (\p -> runConduit $ transPipe liftHandler p .| C.foldMap Set.singleton) yieldMany . genericFileField $ return wpffConfig)
              ( fsl (slI18n wpffLabel)
                  & maybe id (addName . ($ "file")) mNudge
@ -316,29 +360,44 @@ workflowEdgePayloadFields specs = evalRWST (forM specs $ runExceptT . renderSpec
              )
              (fRefs <|> wpfuDefault)
        WorkflowPayloadFieldCaptureUser -> do
-          mAuthId <- liftHandler maybeAuthId
+          mAuthId <- liftHandler maybeAuth
          case mAuthId of
-            Just uid -> (True,  FormSuccess $ _Just . _WorkflowFieldPayloadW . _WorkflowFieldPayload # uid) <$ tell (All True)
+            Just (Entity uid User{userDisplayName, userSurname}) -> do
+              fvId <- newIdent
+              State.modify . List.delete $ _WorkflowFieldPayloadW . _WorkflowFieldPayload # uid
+              lift . lift . lift . tell $ pure FieldView
+                { fvLabel = [shamlet|#{mr MsgWorkflowEdgeFormFieldCaptureUserLabel}|]
+                , fvTooltip = Nothing
+                , fvId
+                , fvInput = [whamlet|
+                              $newline never
+                              <span ##{fvId}>
+                                ^{nameWidget userDisplayName userSurname}
+                            |]
+                , fvErrors = Nothing
+                , fvRequired = False
+                }
+              (True,  FormSuccess . Just . (:| []) $ _WorkflowFieldPayloadW . _WorkflowFieldPayload # uid) <$ tell (All True)
            Nothing  -> (False, FormMissing) <$ tell (All False)
        WorkflowPayloadFieldReference{..} -> throwE wpfrTarget
        WorkflowPayloadFieldMultiple{..} -> do
-          fRefs <- extractPrev @(NonEmpty (WorkflowFieldPayloadW FileReference UserId))
+          fRefs <- nonEmpty <$> State.state (maybe (, []) (splitAt . fromIntegral) $ (+ wpfmMin) <$> wpfmRange)
          miIdent <- newIdent
          wSetTooltip' (fmap slI18n wpfmTooltip) $
            let mPrev' :: Maybe (NonEmpty (WorkflowFieldPayloadW FileReference UserId))
                mPrev' = fRefs <|> wpfmDefault
-                mPrev :: Maybe (Map ListPosition (Maybe (WorkflowFieldPayloadW FileReference UserId), Maybe (WorkflowFieldPayloadW FileReference UserId)))
-                mPrev = Just . Map.fromList . zip [0..] . ensureLength . map (\x -> (Just x, Just x)) $ maybe [] otoList mPrev'
+                mPrev :: Maybe (Map ListPosition (Maybe (WorkflowFieldPayloadW FileReference UserId), Maybe (NonEmpty (WorkflowFieldPayloadW FileReference UserId))))
+                mPrev = Just . Map.fromList . zip [0..] . ensureLength . map (\x -> (Just x, Just $ x :| [])) $ mPrev' ^.. _Just . folded
                  where
-                    ensureLength :: forall a. [(Maybe a, Maybe a)] -> [(Maybe a, Maybe a)]
+                    ensureLength :: forall a b. [(Maybe a, Maybe b)] -> [(Maybe a, Maybe b)]
                    ensureLength = (\l -> (l ++) $ replicate (fromIntegral wpfmMin - length l) (Nothing, Nothing)) . maybe id (take . fromIntegral) ((+ wpfmMin) <$> wpfmRange)
                mangleResult :: forall a.
-                                FormResult (Map ListPosition (a, Maybe (WorkflowFieldPayloadW FileReference UserId)))
-                             -> (Bool, FormResult (Maybe (WorkflowFieldPayloadW FileReference UserId)))
+                                FormResult (Map ListPosition (a, Maybe (NonEmpty (WorkflowFieldPayloadW FileReference UserId))))
+                             -> (Bool, FormResult (Maybe (NonEmpty (WorkflowFieldPayloadW FileReference UserId))))
                -- FieldMultiple are always filled since `massInput` ensures cardinality constraints (iff @mPrev'@ correctly initializes `massInput` with a list of fields of the appropriate length)
                mangleResult res = case matching _FormSuccess res of
                  Right ress
-                    -> (True, FormSuccess . fmap (review $ _WorkflowFieldPayloadW . _WorkflowFieldPayload) . nonEmpty $ ress ^.. folded . _2 . _Just)
+                    -> (True, FormSuccess . nonEmpty $ ress ^.. folded . _2 . _Just . folded)
                  Left res'
                    -> (False, res')
                runMI :: forall a.
@ -361,31 +420,30 @@ workflowEdgePayloadFields specs = evalRWST (forM specs $ runExceptT . renderSpec
                      -> FieldView UniWorX
                      -> Maybe (Html -> MForm (ExceptT WorkflowPayloadLabel Handler) (FormResult (Map ListPosition (Maybe (WorkflowFieldPayloadW FileReference UserId)) -> FormResult (Map ListPosition (Maybe (WorkflowFieldPayloadW FileReference UserId)))), Widget))
                miAdd _pos _dim nudge submitView = Just $ \csrf -> over (_1 . _FormSuccess) tweakRes <$> miForm nudge (Left submitView) csrf
-                  where tweakRes :: Maybe (WorkflowFieldPayloadW FileReference UserId)
+                  where tweakRes :: Maybe (NonEmpty (WorkflowFieldPayloadW FileReference UserId))
                                 -> Map ListPosition (Maybe (WorkflowFieldPayloadW FileReference UserId))
                                 -> FormResult (Map ListPosition (Maybe (WorkflowFieldPayloadW FileReference UserId)))
-                        tweakRes newDat prevData = Map.fromList . zip [startKey..] <$> pure (pure newDat)
+                        tweakRes newDat prevData = Map.fromList . zip [startKey..] <$> pure (map Just $ newDat ^.. _Just . folded)
                          where startKey = maybe 0 succ $ fst <$> Map.lookupMax prevData

                miCell :: ListPosition
                       -> Maybe (WorkflowFieldPayloadW FileReference UserId)
-                       -> Maybe (Maybe (WorkflowFieldPayloadW FileReference UserId))
+                       -> Maybe (Maybe (NonEmpty (WorkflowFieldPayloadW FileReference UserId)))
                       -> (Text -> Text)
-                       -> (Html -> MForm (ExceptT WorkflowPayloadLabel Handler) (FormResult (Maybe (WorkflowFieldPayloadW FileReference UserId)), Widget))
-                miCell _pos dat mPrev'' nudge = miForm nudge . Right $ fromMaybe dat mPrev''
+                       -> (Html -> MForm (ExceptT WorkflowPayloadLabel Handler) (FormResult (Maybe (NonEmpty (WorkflowFieldPayloadW FileReference UserId))), Widget))
+                miCell _pos dat mPrev'' nudge = miForm nudge . Right $ fromMaybe (fmap (:| []) dat) mPrev''

                miForm :: (Text -> Text)
-                       -> Either (FieldView UniWorX) (Maybe (WorkflowFieldPayloadW FileReference UserId))
-                       -> (Html -> MForm (ExceptT WorkflowPayloadLabel Handler) (FormResult (Maybe (WorkflowFieldPayloadW FileReference UserId)), Widget))
+                       -> Either (FieldView UniWorX) (Maybe (NonEmpty (WorkflowFieldPayloadW FileReference UserId)))
+                       -> (Html -> MForm (ExceptT WorkflowPayloadLabel Handler) (FormResult (Maybe (NonEmpty (WorkflowFieldPayloadW FileReference UserId))), Widget))
                miForm nudge mode csrf = do
-                  let runSpecRender :: WriterT [FieldView UniWorX] Handler (Either WorkflowPayloadLabel (Bool, FormResult (Maybe (WorkflowFieldPayloadW FileReference UserId))), Ints, Enctype)
-                                    -> ExceptT WorkflowPayloadLabel Handler (((Bool, FormResult (Maybe (WorkflowFieldPayloadW FileReference UserId))), [FieldView UniWorX]), Ints, Enctype)
+                  let runSpecRender :: WriterT [FieldView UniWorX] Handler (Either WorkflowPayloadLabel (Bool, FormResult (Maybe (NonEmpty (WorkflowFieldPayloadW FileReference UserId)))), Ints, Enctype)
+                                    -> ExceptT WorkflowPayloadLabel Handler (((Bool, FormResult (Maybe (NonEmpty (WorkflowFieldPayloadW FileReference UserId)))), [FieldView UniWorX]), Ints, Enctype)
                      runSpecRender mSR = do
                        ((eRes, s, w), fvs) <- lift $ runWriterT mSR
                        ExceptT . return $ (, s, w) . (, fvs) <$> eRes
-                  ((fFilled, fmRes), fvs') <- mapRWST runSpecRender . fmap (view _1) $ evalRWST (runExceptT $ renderSpecField wpfmSub) (Just $ fromMaybe id mNudge . nudge) (mode ^.. _Right . _Just)
+                  ((fFilled, fmRes), fvs') <- mapRWST runSpecRender . fmap (view _1) $ evalRWST (runExceptT $ renderSpecField wpfmSub) (Just $ fromMaybe id mNudge . nudge) (mode ^.. _Right . _Just . folded)

-                  MsgRenderer mr <- getMsgRenderer
                  let fFilled' = fFilled || isn't _FormSuccess fmRes
                      fmRes' | not fFilled' = FormFailure . pure . maybe (mr MsgValueRequired) (mr . valueRequired) $ fvs ^? _head . to fvLabel'
                             | otherwise    = fmRes
@ -435,7 +493,7 @@ workflowEdgePayloadFields specs = evalRWST (forM specs $ runExceptT . renderSpec
                                  p -> Maybe (SomeRoute UniWorX)
                miButtonAction _ = Nothing

-                miLayout :: MassInputLayout ListLength (Maybe (WorkflowFieldPayloadW FileReference UserId)) (Maybe (WorkflowFieldPayloadW FileReference UserId))
+                miLayout :: MassInputLayout ListLength (Maybe (WorkflowFieldPayloadW FileReference UserId)) (Maybe (NonEmpty (WorkflowFieldPayloadW FileReference UserId)))
                miLayout lLength _ cellWdgts delButtons addWdgts = $(widgetFile "widgets/massinput/workflow-payload-field-multiple/layout")
             in runMI . fmap mangleResult $ massInputW MassInput{..} (fslI $ slI18n wpfmLabel) False mPrev

--- a/src/Handler/Utils/Workflow/Form.hs
+++ b/src/Handler/Utils/Workflow/Form.hs
@ -28,6 +28,8 @@ import qualified Data.List.NonEmpty as NonEmpty

 import qualified Data.Aeson as JSON

+import Utils.Workflow.Lint
+

 newtype FileIdent = FileIdent (CI Text)
  deriving (Eq, Ord, Read, Show, Generic, Typeable)
@ -125,6 +127,18 @@ validateWorkflowGraphForm = do
  fIdentsAvailable <- uses _wgfFiles Map.keysSet
  forM_ (fIdentsReferenced `Set.difference` fIdentsAvailable) $ tellValidationError . MsgWorkflowFileIdentDoesNotExist . views _Wrapped CI.original

+  graph <- use _wgfGraph
+  for_ (lintWorkflowGraph graph) $ \lintIssues -> do
+    addMessageModal Warning (i18n MsgWorkflowDefinitionWarningLinterIssuesMessage) $ Right
+      [whamlet|
+        $newline never
+        _{MsgWorkflowDefinitionWarningLinterIssues}
+        <ul>
+          $forall issue <- otoList lintIssues
+            <li>
+              #{displayException issue}
+      |]
+
 toWorkflowGraphForm :: ( MonadHandler m, HandlerSite m ~ UniWorX
                       )
                    => WorkflowGraph FileReference SqlBackendKey
--- a/src/Handler/Utils/Workflow/Workflow.hs
+++ b/src/Handler/Utils/Workflow/Workflow.hs
@ -1,9 +1,16 @@
 module Handler.Utils.Workflow.Workflow
  ( ensureScope
+  , followEdge
+  , followAutomaticEdges, WorkflowAutomaticEdgeException(..)
  ) where

 import Import

+import Handler.Utils.Workflow.EdgeForm
+
+import qualified Data.Set as Set
+import qualified Data.Map as Map
+

 ensureScope :: WorkflowScope TermId SchoolId CourseId -> CryptoFileNameWorkflowWorkflow -> MaybeT DB WorkflowWorkflowId
 ensureScope wiScope cID = do
@ -15,3 +22,60 @@ ensureScope wiScope cID = do
        & _wisCourse %~ view _SqlKey
  guard $ workflowWorkflowScope == wiScope'
  return wId
+
+followEdge :: ( MonadHandler m
+              , HandlerSite m ~ UniWorX
+              , MonadThrow m
+              )
+           => WorkflowGraph FileReference UserId -> WorkflowEdgeForm -> Maybe (WorkflowState FileReference UserId) -> m (WorkflowState FileReference UserId)
+followEdge graph edgeRes cState = do
+  act <- workflowEdgeFormToAction edgeRes
+  followAutomaticEdges graph $ maybe id (<>) cState (act `ncons` mempty)
+
+data WorkflowAutomaticEdgeException
+  = WorkflowAutomaticEdgeCycle [(WorkflowGraphEdgeLabel, WorkflowGraphNodeLabel)]
+  | WorkflowAutomaticEdgeAmbiguity (Set (WorkflowGraphEdgeLabel, WorkflowGraphNodeLabel))
+  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  deriving anyclass (Exception)
+
+followAutomaticEdges :: forall m.
+                        ( MonadIO m
+                        , MonadThrow m
+                        )
+                     => WorkflowGraph FileReference UserId
+                     -> WorkflowState FileReference UserId -> m (WorkflowState FileReference UserId)
+followAutomaticEdges WorkflowGraph{..} = go []
+  where
+    go :: [(Set WorkflowPayloadLabel, (WorkflowGraphEdgeLabel, WorkflowGraphNodeLabel))] -- ^ Should encode all state from which automatic edges decide whether they can be followed
+       -> WorkflowState FileReference UserId
+       -> m (WorkflowState FileReference UserId)
+    go automaticEdgesTaken history
+      | null automaticEdgeOptions = return history
+      | [(edgeLbl, nodeLbl)] <- automaticEdgeOptions = if
+          | (edgeDecisionInput, (edgeLbl, nodeLbl)) `elem` automaticEdgesTaken
+            -> throwM . WorkflowAutomaticEdgeCycle . reverse $ map (view _2) automaticEdgesTaken
+          | otherwise -> do
+              wpTime <- liftIO getCurrentTime
+              let wpUser = Nothing
+                  wpPayload = mempty
+                  wpTo = nodeLbl
+                  wpVia = edgeLbl
+              go ((edgeDecisionInput, (edgeLbl, nodeLbl)) : automaticEdgesTaken) $ history <> (WorkflowAction{..} `ncons` mempty)
+      | otherwise = throwM . WorkflowAutomaticEdgeAmbiguity $ Set.fromList automaticEdgeOptions
+      where
+        cState = wpTo $ last history
+        automaticEdgeOptions = nub $ do
+          (nodeLbl, WGN{..}) <- Map.toList wgNodes
+          (edgeLbl, WorkflowGraphEdgeAutomatic{..}) <- Map.toList wgnEdges
+          guard $ wgeSource == cState
+          whenIsJust wgePayloadRestriction $ guard . checkPayloadRestriction
+          return (edgeLbl, nodeLbl)
+        checkPayloadRestriction :: PredDNF WorkflowPayloadLabel -> Bool
+        checkPayloadRestriction dnf = maybe False (ofoldr1 (||)) . fromNullable $ map evalConj dnf' 
+          where
+            evalConj = maybe True (ofoldr1 (&&)) . fromNullable . map evalPred
+            evalPred PLVariable{..} = plVar `Set.member`    filledPayloads
+            evalPred PLNegated{..}  = plVar `Set.notMember` filledPayloads
+            dnf' = map (Set.toList . toNullable) . Set.toList $ dnfTerms dnf
+        filledPayloads = Map.keysSet . Map.filter (not . Set.null) $ workflowStateCurrentPayloads history
+        edgeDecisionInput = filledPayloads
--- a/src/Handler/Workflow/Instance/Initiate.hs
+++ b/src/Handler/Workflow/Instance/Initiate.hs
@ -11,6 +11,7 @@ import Utils.Workflow
 import Handler.Utils
 import Handler.Utils.Workflow.EdgeForm
 import Handler.Utils.Workflow.CanonicalRoute
+import Handler.Utils.Workflow.Workflow (followEdge)

 import qualified Data.CaseInsensitive as CI
 import qualified Data.List.NonEmpty as NonEmpty
@ -23,7 +24,7 @@ postGWIInitiateR win

 workflowInstanceInitiateR :: WorkflowInstanceId -> Handler Html
 workflowInstanceInitiateR wiId = do
-  (WorkflowInstance{..}, edgeForm, rScope, mDesc) <- runDB $ do
+  (WorkflowInstance{..}, ((edgeAct, edgeView'), edgeEnc), rScope, mDesc) <- runDB $ do
    wi@WorkflowInstance{..} <- get404 wiId
    edgeForm <- maybeT notFound . MaybeT $ workflowEdgeForm (Left wiId) Nothing
    rScope <- maybeT notFound . toRouteWorkflowScope $ _DBWorkflowScope # workflowInstanceScope
@ -37,29 +38,31 @@ workflowInstanceInitiateR wiId = do
        guard $ workflowInstanceDescriptionLanguage == lang
        return desc

-    return (wi, edgeForm, rScope, mDesc)
+    ((edgeRes, edgeView), edgeEnc) <- liftHandler . runFormPost $ renderAForm FormStandard edgeForm

-  ((edgeRes, edgeView'), edgeEnc) <- runFormPost $ renderAForm FormStandard edgeForm
-
-  formResult edgeRes $ \edgeRes' -> do
-    wwId <- runDB $ do
-      act <- workflowEdgeFormToAction edgeRes'
-
-      insert WorkflowWorkflow
+    edgeAct <- formResultMaybe edgeRes $ \edgeRes' -> do
+      workflowWorkflowState <- view _DBWorkflowState <$> followEdge (_DBWorkflowGraph # workflowInstanceGraph) edgeRes' Nothing
+      
+      wwId <- insert WorkflowWorkflow
        { workflowWorkflowInstance = Just wiId
        , workflowWorkflowScope = workflowInstanceScope
        , workflowWorkflowGraph = workflowInstanceGraph
-        , workflowWorkflowState = view _DBWorkflowState $ act `ncons` mempty
+        , workflowWorkflowState
        }

-    addMessageI Success MsgWorkflowInstanceInitiateSuccess
-    
-    cID <- encrypt wwId
-    redirectAlternatives $ NonEmpty.fromList
-      [ _WorkflowScopeRoute # ( rScope, WorkflowWorkflowR cID WWWorkflowR )
-      , _WorkflowScopeRoute # ( rScope, WorkflowInstanceR workflowInstanceName WIWorkflowsR )
-      , _WorkflowScopeRoute # ( rScope, WorkflowInstanceListR )
-      ]
+      return . Just $ do
+        addMessageI Success MsgWorkflowInstanceInitiateSuccess
+
+        cID <- encrypt wwId
+        redirectAlternatives $ NonEmpty.fromList
+          [ _WorkflowScopeRoute # ( rScope, WorkflowWorkflowR cID WWWorkflowR )
+          , _WorkflowScopeRoute # ( rScope, WorkflowInstanceR workflowInstanceName WIWorkflowsR )
+          , _WorkflowScopeRoute # ( rScope, WorkflowInstanceListR )
+          ]
+
+    return (wi, ((edgeAct, edgeView), edgeEnc), rScope, mDesc)
+
+  sequence_ edgeAct

  (heading, title) <- case rScope of
    WSGlobal -> return (MsgGlobalWorkflowInstanceInitiateHeading $ maybe (CI.original workflowInstanceName) workflowInstanceDescriptionTitle mDesc, MsgGlobalWorkflowInstanceInitiateTitle)
@ -67,7 +70,12 @@ workflowInstanceInitiateR wiId = do

  siteLayoutMsg heading $ do
    setTitleI title
-    let edgeView = wrapForm edgeView' def
-          { formEncoding = edgeEnc
+    let edgeView = wrapForm edgeView' FormSettings
+          { formMethod = POST
+          , formAction = Just . SomeRoute $ _WorkflowScopeRoute # (rScope, WorkflowInstanceR workflowInstanceName WIInitiateR)
+          , formEncoding = edgeEnc
+          , formAttrs = []
+          , formSubmit = FormSubmit
+          , formAnchor = Nothing :: Maybe Text
          }
    $(widgetFile "workflows/instance-initiate")
--- a/src/Handler/Workflow/Workflow/Workflow.hs
+++ b/src/Handler/Workflow/Workflow/Workflow.hs
@ -1,12 +1,55 @@
 module Handler.Workflow.Workflow.Workflow
  ( getGWWWorkflowR, postGWWWorkflowR
+  , getGWWFilesR
  , workflowR
  ) where

 import Import

+import Utils.Form
+import Utils.Workflow
+
+import Handler.Utils
+import Handler.Utils.Workflow.EdgeForm
+import Handler.Utils.Workflow.CanonicalRoute
 import Handler.Utils.Workflow.Workflow

+import qualified Data.Map as Map
+import qualified Data.Set as Set
+import qualified Data.Sequence as Seq
+
+import qualified Control.Monad.State.Class as State
+import Control.Monad.Trans.RWS.Strict (RWST, execRWST)
+
+import qualified Crypto.Saltine.Class as Saltine
+import qualified Data.Binary as Binary
+import qualified Data.ByteArray as BA
+import Crypto.Hash.Algorithms (SHAKE256)
+
+import qualified Data.Text as Text
+import Data.RFC5051 (compareUnicode)
+
+import Data.List (inits)
+
+import qualified Data.Scientific as Scientific
+import Text.Blaze (toMarkup)
+import Data.Void (absurd)
+
+
+data WorkflowHistoryItemActor = WHIASelf | WHIAOther (Maybe (Entity User)) | WHIAHidden | WHIAGone
+  deriving (Generic, Typeable)
+  
+data WorkflowHistoryItem = WorkflowHistoryItem
+  { whiUser :: Maybe WorkflowHistoryItemActor
+  , whiTime :: UTCTime
+  , whiPayloadChanges :: [(Text, ([WorkflowFieldPayloadW Void (Maybe (Entity User))], Maybe (Route UniWorX)))]
+  , whiFrom :: Maybe (Maybe Text) -- ^ outer maybe encodes existence, inner maybe encodes permission to view
+  , whiVia :: Maybe Text
+  , whiTo :: Text
+  } deriving (Generic, Typeable)
+
+makePrisms ''WorkflowHistoryItemActor
+

 getGWWWorkflowR, postGWWWorkflowR :: CryptoFileNameWorkflowWorkflow -> Handler Html
 getGWWWorkflowR = postGWWWorkflowR
@ -16,4 +59,177 @@ postGWWWorkflowR cID = do
  workflowR wId

 workflowR :: WorkflowWorkflowId -> Handler Html
-workflowR = error "not implemented"
+workflowR wwId = do
+  cID <- encrypt wwId
+  
+  (mEdge, rScope, workflowHistory) <- runDB $ do
+    WorkflowWorkflow{..} <- get404 wwId
+    rScope <- maybeT notFound . toRouteWorkflowScope $ _DBWorkflowScope # workflowWorkflowScope
+    mEdgeForm <- workflowEdgeForm (Right wwId) Nothing
+    let canonRoute = _WorkflowScopeRoute # (rScope, WorkflowWorkflowR cID WWWorkflowR)
+
+    mEdge <- for mEdgeForm $ \edgeForm -> do
+      ((edgeRes, edgeView), edgeEnc) <- liftHandler . runFormPost $ renderAForm FormStandard edgeForm
+      edgeAct <- formResultMaybe edgeRes $ \edgeRes' -> do
+        nState <- followEdge (_DBWorkflowGraph # workflowWorkflowGraph) edgeRes' . Just $ _DBWorkflowState # workflowWorkflowState
+
+        update wwId [ WorkflowWorkflowState =. view _DBWorkflowState nState ]
+
+        return . Just $ do
+          addMessageI Success MsgWorkflowWorkflowWorkflowEdgeSuccess
+
+          redirect canonRoute
+      return ((edgeAct, edgeView), edgeEnc)
+
+    workflowHistory <-
+      let go :: forall m.
+                ( MonadHandler m
+                , HandlerSite m ~ UniWorX
+                , MonadThrow m
+                )
+             => WorkflowStateIndex
+             -> Maybe WorkflowGraphNodeLabel
+             -> Map WorkflowPayloadLabel (Set (WorkflowFieldPayloadW FileReference UserId))
+             -> WorkflowAction FileReference UserId
+             -> RWST () [WorkflowHistoryItem] (Map WorkflowPayloadLabel (Set (WorkflowFieldPayloadW FileReference UserId))) (SqlPersistT m) ()
+          go stIx wpFrom currentPayload WorkflowAction{..} = maybeT (return ()) $ do
+            stCID <- encrypt stIx
+            let nodeView nodeLbl = do
+                  WorkflowNodeView{..} <- hoistMaybe $ Map.lookup nodeLbl wgNodes >>= wgnViewers
+                  guardM $ anyM (otoList wnvViewers) hasWorkflowRole'
+                  selectLanguageI18n wnvDisplayLabel
+                whiTime = wpTime
+                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
+            
+            whiTo <- nodeView wpTo
+            whiVia <- traverse selectLanguageI18n $ preview _wgeDisplayLabel =<< mVia
+            
+            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
+              | is _Just mAuthId
+              , wpUser' == mAuthId -> return WHIASelf
+              | otherwise -> lift . maybeT (return WHIAHidden) $ do
+                  viewActors <- hoistMaybe $ preview _wgeViewActor =<< mVia
+                  guardM $ anyM (otoList viewActors) hasWorkflowRole'
+                  resUser <- lift . lift $ traverse getEntity wpUser'
+                  return $ case resUser of
+                    Nothing          -> WHIAOther Nothing
+                    Just Nothing     -> WHIAGone
+                    Just (Just uEnt) -> WHIAOther $ Just uEnt
+            tell $ pure WorkflowHistoryItem{..}
+          WorkflowGraph{..} = _DBWorkflowGraph # workflowWorkflowGraph
+          wState = otoList $ review _DBWorkflowState workflowWorkflowState
+       in fmap (view _2) . (\act -> execRWST act () Map.empty) $ sequence_
+            [ go stIx fromSt payload act
+            | fromSt <- Nothing : map (Just . wpTo) wState 
+            | act <- wState
+            | payload <- map (maybe Map.empty workflowStateCurrentPayloads . fromNullable . Seq.fromList) . tailEx $ inits wState
+            | stIx <- [minBound..]
+            ]
+    return (mEdge, rScope, workflowHistory)
+
+  sequenceOf_ (_Just . _1 . _1 . _Just) mEdge
+
+  (heading, title) <- case rScope of
+    WSGlobal -> return (MsgGlobalWorkflowWorkflowWorkflowHeading cID, MsgGlobalWorkflowWorkflowWorkflowTitle cID)
+    _other -> error "not implemented"
+
+  siteLayoutMsg heading $ do
+    setTitleI title
+    let mEdgeView = mEdge <&> \((_, edgeView'), edgeEnc) -> wrapForm edgeView' FormSettings
+          { formMethod = POST
+          , formAction = Just . SomeRoute $ _WorkflowScopeRoute # (rScope, WorkflowWorkflowR cID WWWorkflowR)
+          , formEncoding = edgeEnc
+          , formAttrs = []
+          , formSubmit = FormSubmit
+          , formAnchor = Nothing :: Maybe Text
+          }
+        historyToWidget WorkflowHistoryItem{..} = $(widgetFile "workflows/workflow/history-item")
+        payloadToWidget :: WorkflowFieldPayloadW Void (Maybe (Entity User)) -> Widget
+        payloadToWidget = \case
+          WorkflowFieldPayloadW (WFPText   t       )
+            -> [whamlet|
+                 $newline never
+                 <p .workflow-payload--text>
+                   #{t}
+               |]
+          WorkflowFieldPayloadW (WFPNumber n       ) -> toWidget . toMarkup $ formatScientific Scientific.Fixed Nothing n
+          WorkflowFieldPayloadW (WFPBool   b       ) -> i18n $ WorkflowPayloadBool b
+          WorkflowFieldPayloadW (WFPDay    d       ) -> formatTimeW SelFormatDate d
+          WorkflowFieldPayloadW (WFPUser   mUserEnt) -> case mUserEnt of
+            Nothing                  -> i18n MsgWorkflowPayloadUserGone
+            Just (Entity _ User{..}) -> nameWidget userDisplayName userSurname
+          WorkflowFieldPayloadW (WFPFile   v       ) -> absurd v
+    $(widgetFile "workflows/workflow")
+
+
+getGWWFilesR :: CryptoFileNameWorkflowWorkflow -> WorkflowPayloadLabel -> CryptoUUIDWorkflowStateIndex -> Handler TypedContent
+getGWWFilesR wwCID wpl stCID = do
+  fRefs <- runDB $ do
+    wwId <- decrypt wwCID
+    WorkflowWorkflow{..} <- get404 wwId
+    stIx <- decrypt stCID
+    payloads <- maybeT notFound . workflowStateSection stIx $ _DBWorkflowState # workflowWorkflowState
+    payloads' <- maybe notFound return . Map.lookup wpl $ workflowStateCurrentPayloads payloads
+    let
+      payloads'' :: [FileReference]
+      payloads'' = payloads' ^.. folded . _WorkflowFieldPayloadW . _WorkflowFieldPayload
+    when (null payloads'') notFound
+    return payloads''
+
+  archiveName <- fmap (flip addExtension (unpack extensionZip) . unpack) . ap getMessageRender . pure $ MsgWorkflowWorkflowFilesArchiveName wwCID wpl stCID
+
+  serveSomeFiles archiveName $ yieldMany fRefs
--- a/src/Jobs/Handler/Files.hs
+++ b/src/Jobs/Handler/Files.hs
@ -76,7 +76,7 @@ workflowFileReferences :: MonadResource m => ConduitT () FileContentReference (S
 workflowFileReferences = mconcat [ E.selectSource (E.from $ pure . (E.^. WorkflowDefinitionGraph)) .| awaitForever (mapMOf_ (typesCustom @WorkflowChildren . _fileReferenceContent . _Just) yield . E.unValue)
                                 , E.selectSource (E.from $ pure . (E.^. WorkflowInstanceGraph  )) .| awaitForever (mapMOf_ (typesCustom @WorkflowChildren . _fileReferenceContent . _Just) yield . E.unValue)
                                 , E.selectSource (E.from $ pure . (E.^. WorkflowWorkflowGraph  )) .| awaitForever (mapMOf_ (typesCustom @WorkflowChildren . _fileReferenceContent . _Just) yield . E.unValue)
-                                 , E.selectSource (E.from $ pure . (E.^. WorkflowWorkflowState  )) .| awaitForever (mapMOf_ (typesCustom @WorkflowChildren . folded @Set . _fileReferenceContent . _Just) yield . E.unValue)
+                                 , E.selectSource (E.from $ pure . (E.^. WorkflowWorkflowState  )) .| awaitForever (mapMOf_ (typesCustom @WorkflowChildren . _fileReferenceContent . _Just) yield . E.unValue)
                                 ]


--- a/src/Model/Migration.hs
+++ b/src/Model/Migration.hs
@ -988,6 +988,11 @@ customMigrations = Map.fromListWith (>>)
  , ( AppliedMigrationKey [migrationVersion|42.0.0|] [version|43.0.0|]
    , return () -- Unused; used to create and fill `ChangelogItemFirstSeen`
    )
+  , ( AppliedMigrationKey [migrationVersion|43.0.0|] [version|44.0.0|]
+    , whenM (tableExists "school") $ do
+        schools <- [sqlQQ| SELECT "shorthand", "exam_discouraged_modes" FROM "school"; |]
+        forM_ schools $ \(sid, Single edModes) -> update sid [SchoolExamDiscouragedModes =. Legacy.examModeDNF edModes]
+    )
  ]


--- a/src/Model/Migration/Types.hs
+++ b/src/Model/Migration/Types.hs
@ -1,8 +1,10 @@
+{-# LANGUAGE UndecidableInstances #-}
+
 module Model.Migration.Types where

 import ClassyPrelude.Yesod
 import Data.Aeson
-import Data.Aeson.TH (deriveJSON)
+import Data.Aeson.TH (deriveJSON, mkParseJSON)

 import Utils.PathPiece

@ -12,6 +14,8 @@ import qualified Model.Types.TH.JSON as Current
 import Data.Universe
 import Data.Universe.TH

+import qualified Data.Set as Set
+

 data SheetType
  = Normal { maxPoints :: Current.Points } -- Erhöht das Maximum, wird gutgeschrieben
@ -84,3 +88,31 @@ deriveJSON defaultOptions
  } ''Transaction

 Current.derivePersistFieldJSON ''Transaction
+
+
+
+data PredLiteral a = PLVariable { plVar :: a } | PLNegated { plVar :: a }
+  deriving (Eq, Ord)
+deriveJSON defaultOptions
+  { constructorTagModifier = camelToPathPiece' 1
+  , sumEncoding = TaggedObject "val" "var"
+  } ''PredLiteral
+  
+newtype PredDNF a = PredDNF { dnfTerms :: Set (NonNull (Set (PredLiteral a))) }
+
+$(return [])
+
+instance ToJSON (PredDNF a) where
+  toJSON = error "toJSON @(Legacy.PredDNF _): not implemented"
+instance (Ord a, FromJSON a) => FromJSON (PredDNF a) where
+  parseJSON = $(mkParseJSON defaultOptions{ tagSingleConstructors = True, sumEncoding = ObjectWithSingleField } ''PredDNF)
+
+newtype ExamModeDNF = ExamModeDNF (PredDNF Current.ExamModePredicate)
+  deriving newtype (ToJSON, FromJSON)
+
+Current.derivePersistFieldJSON ''ExamModeDNF
+
+examModeDNF :: ExamModeDNF -> Current.ExamModeDNF
+examModeDNF (ExamModeDNF PredDNF{..}) = Current.ExamModeDNF . Current.PredDNF $ Set.map (impureNonNull . Set.map toCurrentPredLiteral . toNullable) dnfTerms
+  where toCurrentPredLiteral PLVariable{..} = Current.PLVariable plVar
+        toCurrentPredLiteral PLNegated{..} = Current.PLNegated plVar
--- a/src/Model/Types/Security.hs
+++ b/src/Model/Types/Security.hs
@ -163,7 +163,7 @@ makePrisms ''PredLiteral
 deriveJSON defaultOptions
  { constructorTagModifier = camelToPathPiece' 1
  , fieldLabelModifier = camelToPathPiece' 1
-  , sumEncoding = TaggedObject "val" "var"
+  , sumEncoding = TaggedObject "tag" "variable"
  } ''PredLiteral

 instance PathPiece a => PathPiece (PredLiteral a) where
--- a/src/Model/Types/TH/JSON.hs
+++ b/src/Model/Types/TH/JSON.hs
@ -68,7 +68,7 @@ predNFAesonOptions = defaultOptions
  }
  

-workflowGraphAesonOptions, workflowGraphEdgeAesonOptions, workflowGraphNodeAesonOptions, workflowActionAesonOptions, workflowPayloadViewAesonOptions :: Options
+workflowGraphAesonOptions, workflowGraphEdgeAesonOptions, workflowGraphNodeAesonOptions, workflowActionAesonOptions, workflowPayloadViewAesonOptions, workflowNodeViewAesonOptions :: Options
 workflowGraphAesonOptions = defaultOptions
  { fieldLabelModifier = camelToPathPiece' 1
  }
@ -86,3 +86,6 @@ workflowActionAesonOptions = defaultOptions
 workflowPayloadViewAesonOptions = defaultOptions
  { fieldLabelModifier = camelToPathPiece' 1
  }
+workflowNodeViewAesonOptions = defaultOptions
+  { fieldLabelModifier = camelToPathPiece' 1
+  }
--- a/src/Model/Types/Workflow.hs
+++ b/src/Model/Types/Workflow.hs
@ -4,6 +4,7 @@ module Model.Types.Workflow
  ( WorkflowGraph(..)
  , WorkflowGraphNodeLabel
  , WorkflowGraphNode(..)
+  , WorkflowNodeView(..)
  , WorkflowGraphEdgeLabel
  , WorkflowGraphEdge(..)
  , WorkflowGraphEdgeFormOrder
@ -15,10 +16,11 @@ module Model.Types.Workflow
  , WorkflowPayloadField(..)
  , WorkflowScope(..)
  , WorkflowScope'(..), classifyWorkflowScope
-  , WorkflowPayloadLabel
+  , WorkflowPayloadLabel(..)
+  , WorkflowStateIndex(..), workflowStateIndex, workflowStateSection
  , WorkflowState
  , WorkflowAction(..), _wpTo, _wpVia, _wpPayload, _wpUser, _wpTime
-  , WorkflowFieldPayloadW(..), _WorkflowFieldPayloadW, IsWorkflowFieldPayload
+  , WorkflowFieldPayloadW(..), _WorkflowFieldPayloadW, IsWorkflowFieldPayload', IsWorkflowFieldPayload
  , WorkflowFieldPayload(..), _WorkflowFieldPayload
  , workflowStatePayload, workflowStateCurrentPayloads
  , WorkflowChildren
@ -26,7 +28,7 @@ module Model.Types.Workflow

 import Import.NoModel

-import Model.Types.Security (AuthDNF)
+import Model.Types.Security (AuthDNF, PredDNF)
 import Model.Types.File (FileContentReference, FileFieldUserOption, FileField, _fieldAdditionalFiles, FileReferenceTitleMapConvertible(..))

 import Database.Persist.Sql (PersistFieldSql(..))
@ -74,9 +76,8 @@ newtype WorkflowGraphNodeLabel = WorkflowGraphNodeLabel { unWorkflowGraphNodeLab
  deriving newtype (IsString, ToJSON, ToJSONKey, FromJSON, FromJSONKey, PathPiece, PersistField, PersistFieldSql, Binary)

 data WorkflowGraphNode fileid userid = WGN
-  { wgnDisplayLabel :: Maybe I18nText
-  , wgnFinal        :: Bool
-  , wgnViewers      :: Set (WorkflowRole userid)
+  { wgnFinal        :: Bool
+  , wgnViewers      :: Maybe (WorkflowNodeView userid)
  , wgnEdges        :: Map WorkflowGraphEdgeLabel (WorkflowGraphEdge fileid userid)
  }
  deriving (Generic, Typeable)
@ -85,6 +86,10 @@ deriving instance (Eq fileid, Eq userid, Typeable fileid, Typeable userid, Eq (F
 deriving instance (Ord fileid, Ord userid, Typeable fileid, Typeable userid, Ord (FileField fileid)) => Ord (WorkflowGraphNode fileid userid)
 deriving instance (Show fileid, Show userid, Show (FileField fileid)) => Show (WorkflowGraphNode fileid userid)

+data WorkflowNodeView userid = WorkflowNodeView
+  { wnvViewers :: NonNull (Set (WorkflowRole userid))
+  , wnvDisplayLabel :: I18nText
+  } deriving (Eq, Ord, Read, Show, Data, Generic, Typeable)

 -----  WORKFLOW GRAPH: EDGES  -----

@ -98,14 +103,17 @@ data WorkflowGraphEdge fileid userid
    , wgeActors       :: Set (WorkflowRole userid)
    , wgeForm         :: WorkflowGraphEdgeForm fileid userid
    , wgeDisplayLabel :: I18nText
+    , wgeViewActor    :: Set (WorkflowRole userid)
    }
  | WorkflowGraphEdgeAutomatic
-    { wgeSource       :: WorkflowGraphNodeLabel
+    { wgeSource             :: WorkflowGraphNodeLabel
+    , wgePayloadRestriction :: Maybe (PredDNF WorkflowPayloadLabel)
    }
  | WorkflowGraphEdgeInitial
    { wgeActors       :: Set (WorkflowRole userid)
    , wgeForm         :: WorkflowGraphEdgeForm fileid userid
    , wgeDisplayLabel :: I18nText
+    , wgeViewActor    :: Set (WorkflowRole userid)
    }
  deriving (Generic, Typeable)

@ -167,6 +175,7 @@ data WorkflowPayloadField fileid userid (payload :: Type) where
                                   , wpftPlaceholder :: Maybe I18nText
                                   , wpftTooltip     :: Maybe I18nHtml
                                   , wpftDefault     :: Maybe Text
+                                   , wpftLarge       :: Bool
                                   , wpftOptional    :: Bool
                                   } -> WorkflowPayloadField fileid userid Text
  WorkflowPayloadFieldNumber    :: { wpfnLabel       :: I18nText
@ -183,6 +192,11 @@ data WorkflowPayloadField fileid userid (payload :: Type) where
                                   , wpfbDefault     :: Maybe Bool
                                   , wpfbOptional    :: Maybe I18nText -- ^ Optional if `Just`; encodes label of `Nothing`-Option
                                   } -> WorkflowPayloadField fileid userid Bool
+  WorkflowPayloadFieldDay       :: { wpfdLabel       :: I18nText
+                                   , wpfdTooltip     :: Maybe I18nHtml
+                                   , wpfdDefault     :: Maybe Day
+                                   , wpfdOptional    :: Bool
+                                   } -> WorkflowPayloadField fileid userid Day
  WorkflowPayloadFieldFile      :: { wpffLabel       :: I18nText
                                   , wpffTooltip     :: Maybe I18nHtml
                                   , wpffConfig      :: FileField fileid
@ -226,24 +240,32 @@ instance (Ord fileid, Ord userid, Typeable fileid, Typeable userid, Ord (FileFie
          (WorkflowPayloadFieldBool{}, WorkflowPayloadFieldText{}) -> GT
          (WorkflowPayloadFieldBool{}, WorkflowPayloadFieldNumber{}) -> GT
          (WorkflowPayloadFieldBool{}, _) -> LT
+          (WorkflowPayloadFieldDay{}, WorkflowPayloadFieldText{}) -> GT
+          (WorkflowPayloadFieldDay{}, WorkflowPayloadFieldNumber{}) -> GT
+          (WorkflowPayloadFieldDay{}, WorkflowPayloadFieldBool{}) -> GT
+          (WorkflowPayloadFieldDay{}, _) -> LT
          (WorkflowPayloadFieldFile{}, WorkflowPayloadFieldText{}) -> GT
          (WorkflowPayloadFieldFile{}, WorkflowPayloadFieldNumber{}) -> GT
          (WorkflowPayloadFieldFile{}, WorkflowPayloadFieldBool{}) -> GT
+          (WorkflowPayloadFieldFile{}, WorkflowPayloadFieldDay{}) -> GT
          (WorkflowPayloadFieldFile{}, _) -> LT
          (WorkflowPayloadFieldUser{}, WorkflowPayloadFieldText{}) -> GT
          (WorkflowPayloadFieldUser{}, WorkflowPayloadFieldNumber{}) -> GT
          (WorkflowPayloadFieldUser{}, WorkflowPayloadFieldBool{}) -> GT
+          (WorkflowPayloadFieldUser{}, WorkflowPayloadFieldDay{}) -> GT
          (WorkflowPayloadFieldUser{}, WorkflowPayloadFieldFile{}) -> GT
          (WorkflowPayloadFieldUser{}, _) -> LT
          (WorkflowPayloadFieldCaptureUser{}, WorkflowPayloadFieldText{}) -> GT
          (WorkflowPayloadFieldCaptureUser{}, WorkflowPayloadFieldNumber{}) -> GT
          (WorkflowPayloadFieldCaptureUser{}, WorkflowPayloadFieldBool{}) -> GT
+          (WorkflowPayloadFieldCaptureUser{}, WorkflowPayloadFieldDay{}) -> GT
          (WorkflowPayloadFieldCaptureUser{}, WorkflowPayloadFieldFile{}) -> GT
          (WorkflowPayloadFieldCaptureUser{}, WorkflowPayloadFieldUser{}) -> GT
          (WorkflowPayloadFieldCaptureUser{}, _) -> LT
          (WorkflowPayloadFieldReference{}, WorkflowPayloadFieldText{}) -> GT
          (WorkflowPayloadFieldReference{}, WorkflowPayloadFieldNumber{}) -> GT
          (WorkflowPayloadFieldReference{}, WorkflowPayloadFieldBool{}) -> GT
+          (WorkflowPayloadFieldReference{}, WorkflowPayloadFieldDay{}) -> GT
          (WorkflowPayloadFieldReference{}, WorkflowPayloadFieldFile{}) -> GT
          (WorkflowPayloadFieldReference{}, WorkflowPayloadFieldUser{}) -> GT
          (WorkflowPayloadFieldReference{}, WorkflowPayloadFieldCaptureUser{}) -> GT
@ -255,7 +277,7 @@ _WorkflowPayloadSpec :: forall payload fileid userid.
                     => Prism' (WorkflowPayloadSpec fileid userid) (WorkflowPayloadField fileid userid payload)
 _WorkflowPayloadSpec = prism' WorkflowPayloadSpec $ \(WorkflowPayloadSpec pF) -> cast pF
  
-data WorkflowPayloadField' = WPFText' | WPFNumber' | WPFBool' | WPFFile' | WPFUser' | WPFCaptureUser' | WPFReference' | WPFMultiple'
+data WorkflowPayloadField' = WPFText' | WPFNumber' | WPFBool' | WPFDay' | WPFFile' | WPFUser' | WPFCaptureUser' | WPFReference' | WPFMultiple'
  deriving (Eq, Ord, Enum, Bounded, Show, Read, Data, Generic, Typeable)
  deriving anyclass (Universe, Finite)

@ -289,8 +311,24 @@ newtype WorkflowPayloadLabel = WorkflowPayloadLabel { unWorkflowPayloadLabel ::
  deriving stock (Eq, Ord, Show, Read, Data, Generic, Typeable)
  deriving newtype (IsString, ToJSON, ToJSONKey, FromJSON, FromJSONKey, PathPiece, PersistField, PersistFieldSql, Binary)

+newtype WorkflowStateIndex = WorkflowStateIndex { unWorkflowStateIndex :: Word64 }
+  deriving stock (Eq, Ord, Show, Read, Data, Generic, Typeable)
+  deriving newtype (Num, Real, Integral, Enum, Bounded, ToJSON, FromJSON, PathPiece, Binary)
+
 type WorkflowState fileid userid = NonNull (Seq (WorkflowAction fileid userid))

+workflowStateIndex :: Alternative m
+                   => WorkflowStateIndex
+                   -> WorkflowState fileid userid
+                   -> m (WorkflowAction fileid userid)
+workflowStateIndex (fromIntegral -> i) = maybe empty pure . flip index i . toNullable
+
+workflowStateSection :: MonadPlus m
+                     => WorkflowStateIndex
+                     -> WorkflowState fileid userid
+                     -> m (WorkflowState fileid userid)
+workflowStateSection i wSt = maybe mzero return . fromNullable . Seq.fromList =<< sequenceA (map (flip workflowStateIndex wSt) [0..i])
+
 data WorkflowAction fileid userid = WorkflowAction
  { wpTo      :: WorkflowGraphNodeLabel
  , wpVia     :: WorkflowGraphEdgeLabel
@ -300,7 +338,7 @@ data WorkflowAction fileid userid = WorkflowAction
  }
  deriving (Eq, Ord, Show, Generic, Typeable)

-data WorkflowFieldPayloadW fileid userid = forall payload. IsWorkflowFieldPayload fileid userid payload => WorkflowFieldPayloadW (WorkflowFieldPayload fileid userid payload)
+data WorkflowFieldPayloadW fileid userid = forall payload. IsWorkflowFieldPayload' fileid userid payload => WorkflowFieldPayloadW (WorkflowFieldPayload fileid userid payload)
  deriving (Typeable)

 instance (Eq fileid, Eq userid, Typeable fileid, Typeable userid) => Eq (WorkflowFieldPayloadW fileid userid) where
@ -320,16 +358,16 @@ instance (Ord fileid, Ord userid, Typeable fileid, Typeable userid) => Ord (Work
          (WFPBool{}, WFPText{}) -> GT
          (WFPBool{}, WFPNumber{}) -> GT
          (WFPBool{}, _) -> LT
-          (WFPFiles{}, WFPText{}) -> GT
-          (WFPFiles{}, WFPNumber{}) -> GT
-          (WFPFiles{}, WFPBool{}) -> GT
-          (WFPFiles{}, _) -> LT
-          (WFPUser{}, WFPText{}) -> GT
-          (WFPUser{}, WFPNumber{}) -> GT
-          (WFPUser{}, WFPBool{}) -> GT
-          (WFPUser{}, WFPFiles{}) -> GT
-          (WFPUser{}, _) -> LT
-          (WFPMultiple{}, _) -> GT
+          (WFPDay{}, WFPText{}) -> GT
+          (WFPDay{}, WFPNumber{}) -> GT
+          (WFPDay{}, WFPDay{}) -> GT
+          (WFPDay{}, _) -> LT
+          (WFPFile{}, WFPText{}) -> GT
+          (WFPFile{}, WFPNumber{}) -> GT
+          (WFPFile{}, WFPBool{}) -> GT
+          (WFPFile{}, WFPDay{}) -> GT
+          (WFPFile{}, _) -> LT
+          (WFPUser{}, _) -> GT

 instance (Show fileid, Show userid) => Show (WorkflowFieldPayloadW fileid userid) where
  show (WorkflowFieldPayloadW payload) = show payload
@ -338,9 +376,9 @@ data WorkflowFieldPayload fileid userid (payload :: Type) where
  WFPText     :: Text       -> WorkflowFieldPayload fileid userid Text
  WFPNumber   :: Scientific -> WorkflowFieldPayload fileid userid Scientific
  WFPBool     :: Bool       -> WorkflowFieldPayload fileid userid Bool
-  WFPFiles    :: Set fileid -> WorkflowFieldPayload fileid userid (Set fileid)
+  WFPDay      :: Day        -> WorkflowFieldPayload fileid userid Day
+  WFPFile     :: fileid     -> WorkflowFieldPayload fileid userid fileid
  WFPUser     :: userid     -> WorkflowFieldPayload fileid userid userid
-  WFPMultiple :: NonEmpty (WorkflowFieldPayloadW fileid userid) -> WorkflowFieldPayload fileid userid (NonEmpty (WorkflowFieldPayloadW fileid userid))
  deriving (Typeable)

 deriving instance (Show fileid, Show userid) => Show (WorkflowFieldPayload fileid userid payload)
@ -348,44 +386,49 @@ deriving instance (Typeable fileid, Typeable userid, Eq fileid, Eq userid) => Eq
 deriving instance (Typeable fileid, Typeable userid, Ord fileid, Ord userid) => Ord (WorkflowFieldPayload fileid userid payload)

 _WorkflowFieldPayloadW :: forall payload fileid userid.
-                          ( IsWorkflowFieldPayload fileid userid payload, Typeable fileid, Typeable userid )
+                          ( IsWorkflowFieldPayload' fileid userid payload, Typeable fileid, Typeable userid )
                       => Prism' (WorkflowFieldPayloadW fileid userid) (WorkflowFieldPayload fileid userid payload)
 _WorkflowFieldPayloadW = prism' WorkflowFieldPayloadW $ \(WorkflowFieldPayloadW fp) -> cast fp

-data WorkflowFieldPayload' = WFPText' | WFPNumber' | WFPBool' | WFPFiles' | WFPUser' | WFPMultiple'
+data WorkflowFieldPayload' = WFPText' | WFPNumber' | WFPBool' | WFPDay' | WFPFile' | WFPUser'
  deriving (Eq, Ord, Enum, Bounded, Show, Read, Data, Generic, Typeable)
  deriving anyclass (Universe, Finite)

-class Typeable payload => IsWorkflowFieldPayload fileid userid payload where
-  _WorkflowFieldPayload :: Prism' (WorkflowFieldPayload fileid userid payload) payload
+type IsWorkflowFieldPayload' fileid userid payload = IsWorkflowFieldPayload fileid fileid userid userid payload payload

-instance IsWorkflowFieldPayload fileid userid Text where
+class Typeable payload => IsWorkflowFieldPayload fileid fileid' userid userid' payload payload' where
+  _WorkflowFieldPayload :: Prism (WorkflowFieldPayload fileid userid payload) (WorkflowFieldPayload fileid' userid' payload') payload payload'
+
+instance IsWorkflowFieldPayload fileid fileid userid userid Text Text where
  _WorkflowFieldPayload = prism' WFPText $ \case { WFPText x -> Just x; _other -> Nothing }
-instance IsWorkflowFieldPayload fileid userid Scientific where
+instance IsWorkflowFieldPayload fileid fileid userid userid Scientific Scientific where
  _WorkflowFieldPayload = prism' WFPNumber $ \case { WFPNumber x -> Just x; _other -> Nothing }
-instance IsWorkflowFieldPayload fileid userid Bool where
+instance IsWorkflowFieldPayload fileid fileid userid userid Bool Bool where
  _WorkflowFieldPayload = prism' WFPBool $ \case { WFPBool x -> Just x; _other -> Nothing }
-instance {-# OVERLAPPING #-} Typeable fileid => IsWorkflowFieldPayload fileid userid (Set fileid) where
-  _WorkflowFieldPayload = prism' WFPFiles $ \case { WFPFiles x -> Just x; _other -> Nothing }
-instance {-# OVERLAPPING #-} Typeable userid => IsWorkflowFieldPayload fileid userid userid where
-  _WorkflowFieldPayload = prism' WFPUser $ \case { WFPUser x -> Just x; _other -> Nothing }
-instance (Typeable fileid, Typeable userid) => IsWorkflowFieldPayload fileid userid (NonEmpty (WorkflowFieldPayloadW fileid userid)) where
-  _WorkflowFieldPayload = iso (\(WFPMultiple x) -> x) WFPMultiple
+instance IsWorkflowFieldPayload fileid fileid userid userid Day Day where
+  _WorkflowFieldPayload = prism' WFPDay $ \case { WFPDay x -> Just x; _other -> Nothing }
+instance Typeable fileid => IsWorkflowFieldPayload fileid fileid' userid userid fileid fileid' where
+  _WorkflowFieldPayload = prism WFPFile $ \case { WFPFile x -> Right x; other -> Left $ unsafeCoerce other }
+instance Typeable userid => IsWorkflowFieldPayload fileid fileid userid userid' userid userid' where
+  _WorkflowFieldPayload = prism WFPUser $ \case { WFPUser x -> Right x; other -> Left $ unsafeCoerce other }

-workflowStatePayload :: forall fileid userid payload.
-                        ( IsWorkflowFieldPayload fileid userid payload
-                        , Ord fileid, Ord userid, Ord payload
-                        , Typeable fileid, Typeable userid
-                        )
-                     => WorkflowPayloadLabel -> WorkflowState fileid userid -> Seq (Set payload)
-workflowStatePayload label acts = flip ofoldMap acts $ \WorkflowAction{..} -> Seq.singleton . Map.findWithDefault Set.empty label $ fmap (Set.fromList . concatMap extractPayload . otoList) wpPayload
-  where extractPayload (WorkflowFieldPayloadW fieldPayload)
-          | Just HRefl <- typeOf fieldPayload `eqTypeRep` typeRep @(WorkflowFieldPayload fileid userid payload)
-          = fieldPayload ^.. _WorkflowFieldPayload
-          | Just HRefl <- typeOf fieldPayload `eqTypeRep` typeRep @(WorkflowFieldPayload fileid userid (NonEmpty (WorkflowFieldPayloadW fileid userid)))
-          = concatMap extractPayload . maybe mempty otoList $ fieldPayload ^? _WorkflowFieldPayload 
-          | otherwise
-          = mempty
+-- workflowStatePayload :: forall fileid userid payload.
+--                         ( IsWorkflowFieldPayload' fileid userid payload
+--                         , Ord fileid, Ord userid, Ord payload
+--                         , Typeable fileid, Typeable userid
+--                         , Show userid, Show fileid
+--                         )
+--                      => WorkflowPayloadLabel -> WorkflowState fileid userid -> Seq (Maybe (Set payload))
+-- workflowStatePayload label acts = flip ofoldMap acts $ \WorkflowAction{..} -> Seq.singleton . Map.lookup label $ fmap (Set.fromList . concatMap extractPayload . otoList) wpPayload
+--   where
+--     extractPayload :: WorkflowFieldPayloadW fileid userid -> [payload]
+--     extractPayload = \case
+--       WorkflowFieldPayloadW fieldPayload@(WFPMultiple ps) -> traceShow ("multiple", fieldPayload) . concatMap extractPayload $ otoList ps
+--       WorkflowFieldPayloadW fieldPayload
+--         | Just HRefl <- traceShow ("single", fieldPayload) $ typeOf fieldPayload `eqTypeRep` typeRep @(WorkflowFieldPayload fileid userid payload)
+--           -> fieldPayload ^.. _WorkflowFieldPayload
+--         | otherwise
+--           -> traceShow ("none", fieldPayload) mempty

 workflowStateCurrentPayloads :: forall fileid userid.
                                WorkflowState fileid userid
@ -420,6 +463,7 @@ type family ChildrenWorkflowChildren a where
  ChildrenWorkflowChildren (Key record) = '[]
  ChildrenWorkflowChildren FileContentReference = '[]
  ChildrenWorkflowChildren UTCTime = '[]
+  ChildrenWorkflowChildren Day = '[]
  ChildrenWorkflowChildren (WorkflowPayloadSpec fileid userid)
           = ChildrenWorkflowChildren I18nText
    `Concat` ChildrenWorkflowChildren (Maybe I18nText)
@ -427,6 +471,7 @@ type family ChildrenWorkflowChildren a where
    `Concat` ChildrenWorkflowChildren (Maybe Text)
    `Concat` ChildrenWorkflowChildren (Maybe Scientific)
    `Concat` ChildrenWorkflowChildren (Maybe Bool)
+    `Concat` ChildrenWorkflowChildren (Maybe Day)
    `Concat` ChildrenWorkflowChildren (Maybe fileid)
    `Concat` ChildrenWorkflowChildren (Maybe userid)
    `Concat` ChildrenWorkflowChildren Bool
@ -435,6 +480,7 @@ type family ChildrenWorkflowChildren a where
           = ChildrenWorkflowChildren (WorkflowFieldPayload fileid userid Text)
    `Concat` ChildrenWorkflowChildren (WorkflowFieldPayload fileid userid Scientific)
    `Concat` ChildrenWorkflowChildren (WorkflowFieldPayload fileid userid Bool)
+    `Concat` ChildrenWorkflowChildren (WorkflowFieldPayload fileid userid Day)
    `Concat` ChildrenWorkflowChildren (WorkflowFieldPayload fileid userid fileid)
    `Concat` ChildrenWorkflowChildren (WorkflowFieldPayload fileid userid userid)
  ChildrenWorkflowChildren (WorkflowFieldPayload fileid userid payload)
@ -469,6 +515,7 @@ instance (Typeable userid, Typeable fileid, Typeable fileid', Ord fileid', useri
  typesCustom _ (WorkflowPayloadSpec WorkflowPayloadFieldText{..}) = pure $ WorkflowPayloadSpec WorkflowPayloadFieldText{..}
  typesCustom _ (WorkflowPayloadSpec WorkflowPayloadFieldNumber{..}) = pure $ WorkflowPayloadSpec WorkflowPayloadFieldNumber{..}
  typesCustom _ (WorkflowPayloadSpec WorkflowPayloadFieldBool{..}) = pure $ WorkflowPayloadSpec WorkflowPayloadFieldBool{..}
+  typesCustom _ (WorkflowPayloadSpec WorkflowPayloadFieldDay{..}) = pure $ WorkflowPayloadSpec WorkflowPayloadFieldDay{..}
  typesCustom _ (WorkflowPayloadSpec WorkflowPayloadFieldUser{..}) = pure $ WorkflowPayloadSpec WorkflowPayloadFieldUser{..}
  typesCustom _ (WorkflowPayloadSpec WorkflowPayloadFieldCaptureUser) = pure $ WorkflowPayloadSpec WorkflowPayloadFieldCaptureUser
  typesCustom _ (WorkflowPayloadSpec WorkflowPayloadFieldReference{..}) = pure $ WorkflowPayloadSpec WorkflowPayloadFieldReference{..}
@ -481,39 +528,49 @@ instance (Typeable userid, Typeable userid', Typeable fileid, fileid ~ fileid')
  typesCustom _ (WorkflowPayloadSpec WorkflowPayloadFieldText{..}) = pure $ WorkflowPayloadSpec WorkflowPayloadFieldText{..}
  typesCustom _ (WorkflowPayloadSpec WorkflowPayloadFieldNumber{..}) = pure $ WorkflowPayloadSpec WorkflowPayloadFieldNumber{..}
  typesCustom _ (WorkflowPayloadSpec WorkflowPayloadFieldBool{..}) = pure $ WorkflowPayloadSpec WorkflowPayloadFieldBool{..}
+  typesCustom _ (WorkflowPayloadSpec WorkflowPayloadFieldDay{..}) = pure $ WorkflowPayloadSpec WorkflowPayloadFieldDay{..}
  typesCustom _ (WorkflowPayloadSpec WorkflowPayloadFieldFile{..}) = pure $ WorkflowPayloadSpec WorkflowPayloadFieldFile{..}
  typesCustom _ (WorkflowPayloadSpec WorkflowPayloadFieldCaptureUser) = pure $ WorkflowPayloadSpec WorkflowPayloadFieldCaptureUser
  typesCustom _ (WorkflowPayloadSpec WorkflowPayloadFieldReference{..}) = pure $ WorkflowPayloadSpec WorkflowPayloadFieldReference{..}

-instance (Typeable payload, Typeable fileid, Typeable userid, IsWorkflowFieldPayload fileid userid payload, IsWorkflowFieldPayload fileid' userid' payload', fileid ~ fileid', userid ~ userid') => HasTypesCustom WorkflowChildren (WorkflowFieldPayloadW fileid userid) (WorkflowFieldPayloadW fileid' userid') payload payload' where
+instance (Typeable payload, Typeable fileid, Typeable userid, IsWorkflowFieldPayload' fileid userid payload, IsWorkflowFieldPayload' fileid' userid' payload', fileid ~ fileid', userid ~ userid') => HasTypesCustom WorkflowChildren (WorkflowFieldPayloadW fileid userid) (WorkflowFieldPayloadW fileid' userid') payload payload' where
  typesCustom f pw@(WorkflowFieldPayloadW p) = case typeOf p `eqTypeRep` typeRep @(WorkflowFieldPayload fileid userid payload) of
    Just HRefl -> WorkflowFieldPayloadW <$> typesCustom @WorkflowChildren @(WorkflowFieldPayload fileid userid payload) @(WorkflowFieldPayload fileid' userid' payload') @payload @payload' f p
    Nothing    -> pure pw
  
-instance {-# OVERLAPPING #-} (Typeable fileid, Typeable userid, IsWorkflowFieldPayload fileid userid userid, IsWorkflowFieldPayload fileid' userid' userid', fileid ~ fileid') => HasTypesCustom WorkflowChildren (WorkflowFieldPayloadW fileid userid) (WorkflowFieldPayloadW fileid' userid') userid userid' where
+instance {-# OVERLAPPING #-} (Typeable fileid, Typeable userid, IsWorkflowFieldPayload' fileid userid userid, IsWorkflowFieldPayload' fileid' userid' userid', fileid ~ fileid') => HasTypesCustom WorkflowChildren (WorkflowFieldPayloadW fileid userid) (WorkflowFieldPayloadW fileid' userid') userid userid' where
  typesCustom f pw@(WorkflowFieldPayloadW p) = case typeOf p `eqTypeRep` typeRep @(WorkflowFieldPayload fileid userid userid) of
    Just HRefl -> WorkflowFieldPayloadW <$> typesCustom @WorkflowChildren @(WorkflowFieldPayload fileid userid userid) @(WorkflowFieldPayload fileid' userid' userid') @userid @userid' f p
    Nothing    -> pure $ unsafeCoerce @(WorkflowFieldPayloadW fileid userid) @(WorkflowFieldPayloadW fileid userid') pw -- We have proof that @p@ does not contain a value of type @userid@, therefor coercion is safe

-instance {-# OVERLAPPING #-} (Typeable userid, Typeable fileid, Ord fileid', IsWorkflowFieldPayload fileid userid (Set fileid), IsWorkflowFieldPayload fileid' userid' (Set fileid'), userid ~ userid') => HasTypesCustom WorkflowChildren (WorkflowFieldPayloadW fileid userid) (WorkflowFieldPayloadW fileid' userid') fileid fileid' where
-  typesCustom f pw@(WorkflowFieldPayloadW p) = case typeOf p `eqTypeRep` typeRep @(WorkflowFieldPayload fileid userid (Set fileid)) of
-    Just HRefl -> WorkflowFieldPayloadW <$> typesCustom @WorkflowChildren @(WorkflowFieldPayload fileid userid (Set fileid)) @(WorkflowFieldPayload fileid' userid' (Set fileid')) @(Set fileid) @(Set fileid') (traverseOf (iso Set.toList Set.fromList . traverse) f) p
+instance {-# OVERLAPPING #-} (Typeable userid, Typeable fileid, IsWorkflowFieldPayload' fileid userid fileid, IsWorkflowFieldPayload' fileid' userid' fileid', userid ~ userid') => HasTypesCustom WorkflowChildren (WorkflowFieldPayloadW fileid userid) (WorkflowFieldPayloadW fileid' userid') fileid fileid' where
+  typesCustom f pw@(WorkflowFieldPayloadW p) = case typeOf p `eqTypeRep` typeRep @(WorkflowFieldPayload fileid userid fileid) of
+    Just HRefl -> WorkflowFieldPayloadW <$> typesCustom @WorkflowChildren @(WorkflowFieldPayload fileid userid fileid) @(WorkflowFieldPayload fileid' userid' fileid') @fileid @fileid' f p
    Nothing    -> pure $ unsafeCoerce @(WorkflowFieldPayloadW fileid userid) @(WorkflowFieldPayloadW fileid' userid) pw -- We have proof that @p@ does not contain a value of type @fileid@, therefor coercion is safe

-instance (IsWorkflowFieldPayload fileid userid payload, IsWorkflowFieldPayload fileid' userid' payload') => HasTypesCustom WorkflowChildren (WorkflowFieldPayload fileid userid payload) (WorkflowFieldPayload fileid' userid' payload') payload payload' where
+instance (IsWorkflowFieldPayload' fileid userid payload, IsWorkflowFieldPayload' fileid' userid' payload') => HasTypesCustom WorkflowChildren (WorkflowFieldPayload fileid userid payload) (WorkflowFieldPayload fileid' userid' payload') payload payload' where
  typesCustom f x = case x ^? _WorkflowFieldPayload of
    Just x' -> review _WorkflowFieldPayload <$> f x'
    Nothing -> error "@WorkflowFieldPayload fileid userid payload@ does not contain value of type @payload@; this means `IsWorkflowFieldPayload` is invalid"

-instance (Ord userid, Ord fileid, Typeable payload, Typeable fileid, Typeable userid, IsWorkflowFieldPayload fileid userid payload, IsWorkflowFieldPayload fileid' userid' payload', fileid ~ fileid', userid ~ userid') => HasTypesCustom WorkflowChildren (WorkflowAction fileid userid) (WorkflowAction fileid' userid') payload payload' where
+instance (Ord userid, Ord fileid, Typeable payload, Typeable fileid, Typeable userid, IsWorkflowFieldPayload' fileid userid payload, IsWorkflowFieldPayload' fileid' userid' payload', fileid ~ fileid', userid ~ userid') => HasTypesCustom WorkflowChildren (WorkflowAction fileid userid) (WorkflowAction fileid' userid') payload payload' where
  typesCustom = _wpPayload . typesCustom @WorkflowChildren
  
-instance {-# OVERLAPPING #-} (Ord userid', Ord fileid, Typeable fileid, IsWorkflowFieldPayload fileid userid userid, IsWorkflowFieldPayload fileid' userid' userid', fileid ~ fileid') => HasTypesCustom WorkflowChildren (WorkflowAction fileid userid) (WorkflowAction fileid' userid') userid userid' where
+instance {-# OVERLAPPING #-} (Ord userid', Ord fileid, Typeable fileid, IsWorkflowFieldPayload' fileid userid userid, IsWorkflowFieldPayload' fileid' userid' userid', fileid ~ fileid') => HasTypesCustom WorkflowChildren (WorkflowAction fileid userid) (WorkflowAction fileid' userid') userid userid' where
  typesCustom f WorkflowAction{..} = WorkflowAction wpTo wpVia
    <$> traverseOf (typesCustom @WorkflowChildren @_ @_ @userid @userid') f wpPayload
    <*> traverseOf (_Just . _Just) f wpUser
    <*> pure wpTime

+
+workflowStatePayload :: forall fileid userid payload.
+                        ( HasTypesCustom WorkflowChildren (WorkflowFieldPayloadW fileid userid) (WorkflowFieldPayloadW fileid userid) payload payload
+                        , Ord payload
+                        )
+                     => WorkflowPayloadLabel -> WorkflowState fileid userid -> Seq (Maybe (Set payload))
+workflowStatePayload label acts = flip ofoldMap acts $ \WorkflowAction{..} -> Seq.singleton . Map.lookup label $ fmap (setOf $ folded . typesCustom @WorkflowChildren @(WorkflowFieldPayloadW fileid userid) @(WorkflowFieldPayloadW fileid userid) @payload @payload) wpPayload
+
+
 ----- PathPiece instances -----

 nullaryPathPiece ''WorkflowScope' $ camelToPathPiece' 1 . fromJust . stripSuffix "'"
@ -528,15 +585,19 @@ derivePathPiece ''WorkflowScope (camelToPathPiece' 1) "--"
 omitNothing :: [JSON.Pair] -> [JSON.Pair]
 omitNothing = filter . hasn't $ _2 . _Null

+  
 deriveJSON defaultOptions
  { fieldLabelModifier = camelToPathPiece' 2
  , constructorTagModifier = camelToPathPiece' 2
  } ''WorkflowRole

+deriveToJSON workflowNodeViewAesonOptions ''WorkflowNodeView
 deriveToJSON workflowPayloadViewAesonOptions ''WorkflowPayloadView
 pathPieceJSON ''WorkflowFieldPayload'
 pathPieceJSON ''WorkflowPayloadField'

+instance (FromJSON userid, Ord userid) => FromJSON (WorkflowNodeView userid) where
+  parseJSON = genericParseJSON workflowNodeViewAesonOptions
 instance (FromJSON userid, Ord userid) => FromJSON (WorkflowPayloadView userid) where
  parseJSON = genericParseJSON workflowPayloadViewAesonOptions

@ -567,7 +628,8 @@ instance ToJSON WorkflowGraphEdgeFormOrder where
 instance FromJSON WorkflowGraphEdgeFormOrder where
  parseJSON v = fmap WorkflowGraphEdgeFormOrder $ asum
    [ Just <$> parseJSON v
-    , JSON.withText "WorkflowGraphEdgeFormOrder" (bool (fail "WorkflowGraphEdgeFormOrder: unexpected String, expecting either number or \"_\"") (pure Nothing) . (== "_")) v
+    , flip (JSON.withText "WorkflowGraphEdgeFormOrder") v $ \t -> maybe (fail "WorkflowGraphEdgeFormOrder: could not parse String as Number") (return . Just) $ readMay t
+    , flip (JSON.withText "WorkflowGraphEdgeFormOrder") v $ bool (fail "WorkflowGraphEdgeFormOrder: unexpected String, expecting either number or \"_\"") (pure Nothing) . (== "_")
    ]

 instance ToJSONKey WorkflowGraphEdgeFormOrder where
@ -575,9 +637,7 @@ instance ToJSONKey WorkflowGraphEdgeFormOrder where
    where toText' = decodeUtf8 . toStrict . JSON.encodingToLazyByteString . JSON.scientific
          toEncoding' = JSON.scientificText
 instance FromJSONKey WorkflowGraphEdgeFormOrder where
-  fromJSONKey = JSON.FromJSONKeyTextParser $ \t -> if
-    | t == "_"  -> pure $ WorkflowGraphEdgeFormOrder Nothing
-    | otherwise -> WorkflowGraphEdgeFormOrder . Just <$> parseJSON (JSON.String t)
+  fromJSONKey = JSON.FromJSONKeyTextParser $ parseJSON . JSON.String

 instance (ToJSON fileid, ToJSON userid, ToJSON (FileField fileid)) => ToJSON (WorkflowGraphEdgeForm fileid userid) where
  toJSON WorkflowGraphEdgeForm{..} = toJSON . flip map wgefFields $ \(toNullable -> disj) -> flip Set.map disj $ \(toNullable -> orderedFields) -> if
@ -608,6 +668,7 @@ instance (ToJSON fileid, ToJSON userid, ToJSON (FileField fileid)) => ToJSON (Wo
    , "placeholder" JSON..=  wpftPlaceholder
    , "tooltip"     JSON..=  wpftTooltip
    , "default"     JSON..=  wpftDefault
+    , "large"       JSON..=  wpftLarge
    , "optional"    JSON..=  wpftOptional
    ]
  toJSON (WorkflowPayloadFieldNumber{..}) = JSON.object $ omitNothing
@ -628,6 +689,13 @@ instance (ToJSON fileid, ToJSON userid, ToJSON (FileField fileid)) => ToJSON (Wo
    , "default"     JSON..=  wpfbDefault
    , "optional"    JSON..=  wpfbOptional
    ]
+  toJSON (WorkflowPayloadFieldDay{..}) = JSON.object $ omitNothing
+    [ "tag"         JSON..=  WPFDay'
+    , "label"       JSON..=  wpfdLabel
+    , "tooltip"     JSON..=  wpfdTooltip
+    , "default"     JSON..=  wpfdDefault
+    , "optional"    JSON..=  wpfdOptional
+    ]
  toJSON (WorkflowPayloadFieldFile{..}) = JSON.object $ omitNothing
    [ "tag"         JSON..=  WPFFile'
    , "label"       JSON..=  wpffLabel
@ -672,6 +740,7 @@ instance ( FromJSON fileid, FromJSON userid
        wpftPlaceholder <-  o JSON..:? "placeholder"
        wpftTooltip     <-  o JSON..:? "tooltip"
        wpftDefault     <-  o JSON..:? "default"
+        wpftLarge       <-  o JSON..:? "large" JSON..!= False
        wpftOptional    <-  o JSON..:  "optional"
        return $ WorkflowPayloadSpec WorkflowPayloadFieldText{..}
      WPFNumber' -> do
@ -681,15 +750,21 @@ instance ( FromJSON fileid, FromJSON userid
        wpfnDefault     <- (o JSON..:? "default" :: Parser (Maybe Scientific))
        wpfnMin         <-  o JSON..:? "min"
        wpfnMax         <-  o JSON..:? "max"
-        wpfnStep        <-  o JSON..:  "step"
+        wpfnStep        <-  o JSON..:? "step"
        wpfnOptional    <-  o JSON..:  "optional"
        return $ WorkflowPayloadSpec WorkflowPayloadFieldNumber{..}
      WPFBool' -> do
        wpfbLabel       <-  o JSON..:  "label"
        wpfbTooltip     <-  o JSON..:? "tooltip"
-        wpfbOptional    <-  o JSON..:  "optional"
-        wpfbDefault     <- (o JSON..:  "default" :: Parser (Maybe Bool))
+        wpfbOptional    <-  o JSON..:? "optional"
+        wpfbDefault     <- (o JSON..:? "default" :: Parser (Maybe Bool))
        return $ WorkflowPayloadSpec WorkflowPayloadFieldBool{..}
+      WPFDay' -> do
+        wpfdLabel       <-  o JSON..:  "label"
+        wpfdTooltip     <-  o JSON..:? "tooltip"
+        wpfdOptional    <-  o JSON..:  "optional"
+        wpfdDefault     <- (o JSON..:? "default" :: Parser (Maybe Day))
+        return $ WorkflowPayloadSpec WorkflowPayloadFieldDay{..}
      WPFFile' -> do
        wpffLabel       <-  o JSON..:  "label"
        wpffTooltip     <-  o JSON..:? "tooltip"
@ -753,18 +828,18 @@ instance (ToJSON fileid, ToJSON userid) => ToJSON (WorkflowFieldPayloadW fileid
    [ "tag"    JSON..= WFPBool' 
    , toPathPiece WFPBool' JSON..= b
    ]
-  toJSON (WorkflowFieldPayloadW (WFPFiles fid)) = JSON.object
-    [ "tag"    JSON..= WFPFiles'
-    , toPathPiece WFPFiles' JSON..= fid
+  toJSON (WorkflowFieldPayloadW (WFPDay    d)) = JSON.object
+    [ "tag"    JSON..= WFPDay' 
+    , toPathPiece WFPDay' JSON..= d
+    ]
+  toJSON (WorkflowFieldPayloadW (WFPFile fid)) = JSON.object
+    [ "tag"    JSON..= WFPFile'
+    , toPathPiece WFPFile' JSON..= fid
    ]
  toJSON (WorkflowFieldPayloadW (WFPUser uid)) = JSON.object
    [ "tag"    JSON..= WFPUser'
    , toPathPiece WFPUser' JSON..= uid
    ]
-  toJSON (WorkflowFieldPayloadW (WFPMultiple uid)) = JSON.object
-    [ "tag"    JSON..= WFPMultiple'
-    , toPathPiece WFPMultiple' JSON..= uid
-    ]
 instance (Ord fileid, FromJSON fileid, FromJSON userid, Typeable fileid, Typeable userid) => FromJSON (WorkflowFieldPayloadW fileid userid) where
  parseJSON = JSON.withObject "WorkflowFieldPayloadW" $ \o -> do
    fieldTag <- o JSON..: "tag"
@ -778,15 +853,15 @@ instance (Ord fileid, FromJSON fileid, FromJSON userid, Typeable fileid, Typeabl
      WFPBool'   -> do
        b <- o JSON..: toPathPiece WFPBool'
        return $ WorkflowFieldPayloadW $ WFPBool b
-      WFPFiles'  -> do
-        fid <- o JSON..: toPathPiece WFPFiles'
-        return $ WorkflowFieldPayloadW $ WFPFiles fid
+      WFPDay'   -> do
+        b <- o JSON..: toPathPiece WFPDay'
+        return $ WorkflowFieldPayloadW $ WFPDay b
+      WFPFile'  -> do
+        fid <- o JSON..: toPathPiece WFPFile'
+        return $ WorkflowFieldPayloadW $ WFPFile fid
      WFPUser'   -> do
        uid <- o JSON..: toPathPiece WFPUser'
        return $ WorkflowFieldPayloadW $ WFPUser uid
-      WFPMultiple'   -> do
-        uid <- o JSON..: toPathPiece WFPMultiple'
-        return $ WorkflowFieldPayloadW $ WFPMultiple uid



--- a/src/Utils/Workflow.hs
+++ b/src/Utils/Workflow.hs
@ -1,12 +1,22 @@
+{-# OPTIONS -Wno-error=redundant-constraints #-}
+
 module Utils.Workflow
  ( _DBWorkflowScope
  , fromRouteWorkflowScope, toRouteWorkflowScope
  , _DBWorkflowGraph
  , _DBWorkflowState
+  , decryptWorkflowStateIndex, encryptWorkflowStateIndex
  ) where

 import Import.NoFoundation

+import qualified Data.CryptoID.Class.ImplicitNamespace as I
+import qualified Crypto.MAC.KMAC as Crypto
+import qualified Data.ByteArray as BA
+import qualified Data.Binary as Binary
+import Crypto.Hash.Algorithms (SHAKE256)
+import Language.Haskell.TH (nameBase)
+

 _DBWorkflowScope :: Iso' (WorkflowScope TermId SchoolId CourseId) (WorkflowScope TermIdentifier SchoolShorthand SqlBackendKey)
 _DBWorkflowScope = iso toScope' toScope
@ -46,3 +56,31 @@ _DBWorkflowState = iso toDB fromDB
  where
    toDB = over (typesCustom @WorkflowChildren @(WorkflowState FileReference UserId) @(WorkflowState FileReference SqlBackendKey) @UserId @SqlBackendKey) (view _SqlKey)
    fromDB = over (typesCustom @WorkflowChildren @(WorkflowState FileReference SqlBackendKey) @(WorkflowState FileReference UserId) @SqlBackendKey @UserId) (review _SqlKey)
+
+
+data WorkflowStateIndexKeyException
+  = WorkflowStateIndexCryptoIDKeyCouldNotDecodeRandom
+  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  deriving anyclass (Exception)
+  
+workflowStateIndexCryptoIDKey :: (MonadCrypto m, MonadCryptoKey m ~ CryptoIDKey) => WorkflowWorkflowId -> m CryptoIDKey
+workflowStateIndexCryptoIDKey wwId = cryptoIDKey $ \cIDKey -> either (const $ throwM WorkflowStateIndexCryptoIDKeyCouldNotDecodeRandom) (views _3 return) . Binary.decodeOrFail . fromStrict . BA.convert $
+  Crypto.kmac @(SHAKE256 CryptoIDCipherKeySize) (encodeUtf8 . (pack :: String -> Text) $ nameBase 'workflowStateIndexCryptoIDKey) (toStrict $ Binary.encode wwId) cIDKey
+  
+encryptWorkflowStateIndex :: ( MonadCrypto m
+                             , MonadCryptoKey m ~ CryptoIDKey
+                             , MonadHandler m
+                             )
+                          => WorkflowWorkflowId -> WorkflowStateIndex -> m CryptoUUIDWorkflowStateIndex
+encryptWorkflowStateIndex wwId stIx = do
+  cIDKey <- workflowStateIndexCryptoIDKey wwId
+  $cachedHereBinary (wwId, stIx) . flip runReaderT cIDKey $ I.encrypt stIx
+  
+decryptWorkflowStateIndex :: ( MonadCrypto m
+                             , MonadCryptoKey m ~ CryptoIDKey
+                             , MonadHandler m
+                             )
+                          => WorkflowWorkflowId -> CryptoUUIDWorkflowStateIndex -> m WorkflowStateIndex
+decryptWorkflowStateIndex wwId cID = do
+  cIDKey <- workflowStateIndexCryptoIDKey wwId
+  $cachedHereBinary (wwId, cID) . flip runReaderT cIDKey $ I.decrypt cID
--- a/src/Utils/Workflow/Lint.hs
+++ b/src/Utils/Workflow/Lint.hs
@ -0,0 +1,41 @@
+module Utils.Workflow.Lint
+  ( lintWorkflowGraph
+  , WorkflowGraphLinterIssue(..)
+  ) where
+
+import Import.NoFoundation
+
+import qualified Data.Set as Set
+import qualified Data.Map as Map
+
+
+data WorkflowGraphLinterIssue
+  = WGLUnknownGraphNodeLabel WorkflowGraphNodeLabel
+  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+
+instance Exception WorkflowGraphLinterIssue where
+  displayException = \case
+    WGLUnknownGraphNodeLabel nodeLbl -> unpack [st|Unknown GraphNodeLabel: “#{toPathPiece nodeLbl}”|]
+
+lintWorkflowGraph :: WorkflowGraph fileid userid -> Maybe (NonNull (Set WorkflowGraphLinterIssue))
+lintWorkflowGraph graph = fromNullable . Set.fromList $ concatMap ($ graph)
+  [ checkEdgesForUnknownGraphNodeLabel
+    -- Future ideas:
+    --   - node with no outgoing edges that isn't final
+    --   - WorkflowRolePayloadReference for unknown payload
+    --   - wgePayloadRestriction for unknown payload
+    --   - Undefined field order
+    --   - FieldReference for payload not defined in same form
+    --   - WorkflowRolePayloadReference to payload without user fields
+    --   - unreachable nodes
+    --   - all initial edges have only payload-reference
+    --   - cycles of automatic edges (also consider payload restrictions; computationally equivalent to SAT)
+  ]
+  where
+    checkEdgesForUnknownGraphNodeLabel WorkflowGraph{wgNodes} = foldMap (pure . WGLUnknownGraphNodeLabel) $ Set.fromList edgeNodeLabels `Set.difference` Map.keysSet wgNodes
+      where
+        edges = foldMap (Map.elems . wgnEdges) wgNodes
+        edgeNodeLabels = flip foldMap edges $ \case
+          WorkflowGraphEdgeManual{wgeSource} -> pure wgeSource
+          WorkflowGraphEdgeAutomatic{wgeSource} -> pure wgeSource
+          WorkflowGraphEdgeInitial{} -> []
--- a/templates/workflows/workflow.hamlet
+++ b/templates/workflows/workflow.hamlet
@ -0,0 +1,14 @@
+$newline never
+<section>
+  <h2>
+    _{MsgWorkflowWorkflowWorkflowHistoryHeading}
+
+  <ul .workflow-history>
+    $forall histItem <- workflowHistory
+      ^{historyToWidget histItem}
+$maybe edgeView <- mEdgeView
+  <section>
+    <h2>
+      _{MsgWorkflowWorkflowWorkflowEdgeFormHeading}
+    ^{edgeView}
+  
--- a/templates/workflows/workflow/history-item.hamlet
+++ b/templates/workflows/workflow/history-item.hamlet
@ -0,0 +1,59 @@
+$newline never
+<li .workflow-history--item :is (_Just . _WHIASelf) whiUser:.workflow-history-item__self>
+  <div .workflow-history--item-user>
+    $maybe user <- whiUser
+      $case user
+        $of WHIASelf
+          <span .workflow-history--item-user-special>
+            _{MsgWorkflowWorkflowWorkflowHistoryUserSelf}
+        $of WHIAOther mUser
+          $maybe Entity _ User{userDisplayName, userSurname} <- mUser
+            ^{nameWidget userDisplayName userSurname}
+          $nothing
+            <span .workflow-history--item-user-special>
+              _{MsgWorkflowWorkflowWorkflowHistoryUserNotLoggedIn}
+        $of WHIAGone
+            <span .workflow-history--item-user-special>
+              _{MsgWorkflowWorkflowWorkflowHistoryUserGone}
+        $of WHIAHidden
+            <span .workflow-history--item-user-special>
+              _{MsgWorkflowWorkflowWorkflowHistoryUserHidden}
+    $nothing
+      <span .workflow-history--item-user-special>
+        _{MsgWorkflowWorkflowWorkflowHistoryUserAutomatic}
+  <div .workflow-history--item-time>
+    ^{formatTimeW SelFormatDateTime whiTime}
+  <div .workflow-history--item-action>
+    $maybe actionLbl <- whiVia
+      #{actionLbl}
+    $nothing
+      <span .workflow-history--item-action-special>
+        _{MsgWorkflowWorkflowWorkflowHistoryActionAutomatic}
+  <div .workflow-history--item-states>
+    <div .workflow-history--item-state-from>
+      $maybe mFromLbl <- whiFrom
+        $maybe fromLbl <- mFromLbl
+          #{fromLbl}
+        $nothing
+          <span .workflow-history--item-state-special>
+            _{MsgWorkflowWorkflowWorkflowHistoryStateHidden}
+    <div .workflow-history--item-state-to>
+      #{whiTo}
+  $if not (onull whiPayloadChanges)
+    <div .workflow-history--item-payload-changes>
+      <dl .deflist>
+        $forall (payloadLbl, (newPayload, mFileRoute)) <- whiPayloadChanges
+          <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}
--- a/test/Data/NonNull/TestInstances.hs
+++ b/test/Data/NonNull/TestInstances.hs
@ -0,0 +1,9 @@
+module Data.NonNull.TestInstances
+  (
+  ) where
+
+import TestImport
+
+
+instance (Arbitrary a, MonoFoldable a) => Arbitrary (NonNull a) where
+  arbitrary = arbitrary `suchThatMap` fromNullable
--- a/test/Database/Fill.hs
+++ b/test/Database/Fill.hs
@ -33,6 +33,8 @@ import qualified Data.Conduit.Combinators as C

 import qualified Data.Yaml as Yaml

+import Utils.Workflow.Lint
+

 testdataDir :: FilePath
 testdataDir = "testdata"
@ -1285,25 +1287,9 @@ fillDb = do
  
  liftIO . LBS.writeFile (testdataDir </> "bigAlloc_ordinal.csv") $ Csv.encode ordinalPriorities

-  do
-    workflowDefinitionGraph <- Yaml.decodeFileThrow $ testdataDir </> "exam-rooms.yaml"
-    let
-      examRoomsWorkflowDef = WorkflowDefinition{..}
-        where workflowDefinitionInstanceCategory = Just "rooms"
-              workflowDefinitionName = "exam-rooms"
-              workflowDefinitionScope = WSGlobal' -- TODO
-    wdId <- insert examRoomsWorkflowDef
-    let
-      examRoomsWorkflowInst = WorkflowInstance{..}
-        where workflowInstanceDefinition = Just wdId
-              workflowInstanceGraph = workflowDefinitionGraph
-              workflowInstanceScope = WSGlobal -- TODO
-              workflowInstanceName = workflowDefinitionName examRoomsWorkflowDef
-              workflowInstanceCategory = workflowDefinitionInstanceCategory examRoomsWorkflowDef
-    insert_ examRoomsWorkflowInst
-  
  do
    workflowDefinitionGraph <- Yaml.decodeFileThrow $ testdataDir </> "theses.yaml"
+    for_ (lintWorkflowGraph workflowDefinitionGraph) $ mapM_ throwM
    let
      thesesWorkflowDef = WorkflowDefinition{..}
        where workflowDefinitionInstanceCategory = Just "theses"
--- a/test/Database/Persist/Sql/Types/TestInstances.hs
+++ b/test/Database/Persist/Sql/Types/TestInstances.hs
@ -0,0 +1,12 @@
+module Database.Persist.Sql.Types.TestInstances
+  (
+  ) where
+
+import TestImport
+
+import Database.Persist.Sql
+  
+
+deriving newtype instance Arbitrary (BackendKey SqlBackend)
+deriving newtype instance Arbitrary (BackendKey SqlWriteBackend)
+deriving newtype instance Arbitrary (BackendKey SqlReadBackend)
--- a/test/FoundationSpec.hs
+++ b/test/FoundationSpec.hs
@ -82,6 +82,18 @@ instance Arbitrary CourseEventR where
  arbitrary = genericArbitrary
  shrink = genericShrink

+instance Arbitrary AdminWorkflowDefinitionR where
+  arbitrary = genericArbitrary
+  shrink = genericShrink
+  
+instance Arbitrary GlobalWorkflowInstanceR where
+  arbitrary = genericArbitrary
+  shrink = genericShrink
+
+instance Arbitrary GlobalWorkflowWorkflowR where
+  arbitrary = genericArbitrary
+  shrink = genericShrink
+
 instance Arbitrary (Route UniWorX) where
  arbitrary = genericArbitrary
  shrink = genericShrink
--- a/test/Model/Types/FileSpec.hs
+++ b/test/Model/Types/FileSpec.hs
@ -0,0 +1,72 @@
+{-# LANGUAGE UndecidableInstances #-}
+
+module Model.Types.FileSpec where
+
+import TestImport
+import TestInstances ()
+
+import Data.Conduit
+import qualified Data.Conduit.Combinators as C
+
+import Data.Ratio ((%))
+
+import System.FilePath
+import Data.Time
+
+import qualified Data.Map as Map
+
+
+scaleRatio :: Rational -> Int -> Int
+scaleRatio r = ceiling . (* r) . fromIntegral
+
+instance (LazySequence lazy strict, Arbitrary lazy, Monad m) => Arbitrary (ConduitT () strict m ()) where
+  arbitrary = C.sourceLazy <$> arbitrary
+
+instance Monad m => Arbitrary (File m) where
+  arbitrary = do
+    fileTitle <- scale (scaleRatio $ 1 % 8) $ (joinPath <$> arbitrary) `suchThat` (any $ not . isPathSeparator)
+    date <- addDays <$> arbitrary <*> pure (fromGregorian 2043 7 2)
+    fileModified <- (addUTCTime <$> arbitrary <*> pure (UTCTime date 0)) `suchThat` inZipRange
+    fileContent <- oneof
+      [ pure Nothing
+      , Just <$> scale (scaleRatio $ 7 % 8) arbitrary
+      ]
+    return File{..}
+    where
+      inZipRange :: UTCTime -> Bool
+      inZipRange time
+        | time > UTCTime (fromGregorian 1980 1 1) 0
+        , time < UTCTime (fromGregorian 2107 1 1) 0
+        = True
+        | otherwise
+        = False
+
+instance Arbitrary FileReference where
+  arbitrary = pureFileToFileReference <$> arbitrary
+
+instance Arbitrary a => Arbitrary (FileFieldUserOption a) where
+  arbitrary = genericArbitrary
+  shrink = genericShrink
+
+instance Arbitrary add => Arbitrary (FileReferenceTitleMap FileReference add) where
+  arbitrary = do
+    fRefs <- arbitrary
+    fmap (review _FileReferenceFileReferenceTitleMap . Map.fromList) . for fRefs $ \FileReference{..} -> (fileReferenceTitle, ) . (fileReferenceContent, fileReferenceModified, ) <$> arbitrary
+
+instance Arbitrary (FileReferenceTitleMap fileid (FileFieldUserOption Bool)) => Arbitrary (FileField fileid) where
+  arbitrary = genericArbitrary
+  shrink = genericShrink
+
+spec :: Spec
+spec = do
+  parallel $ do
+    lawsCheckHspec (Proxy @PureFile)
+      [ eqLaws, ordLaws, showLaws ]
+    lawsCheckHspec (Proxy @FileReference)
+      [ eqLaws, ordLaws, hashableLaws, binaryLaws, jsonLaws ]
+    lawsCheckHspec (Proxy @(FileFieldUserOption Bool))
+      [ eqLaws, ordLaws, showLaws, showReadLaws, jsonLaws ]
+    lawsCheckHspec (Proxy @(FileReferenceTitleMap FileReference (FileFieldUserOption Bool)))
+      [ eqLaws, ordLaws, semigroupLaws, monoidLaws, semigroupMonoidLaws, idempotentSemigroupLaws, commutativeSemigroupLaws ]
+    lawsCheckHspec (Proxy @(FileField FileReference))
+      [ eqLaws, ordLaws, jsonLaws ]
--- a/test/Model/Types/WorkflowSpec.hs
+++ b/test/Model/Types/WorkflowSpec.hs
@ -0,0 +1,150 @@
+module Model.Types.WorkflowSpec where
+
+import TestImport hiding (NonEmpty)
+import TestInstances ()
+
+import Data.Scientific (Scientific)
+import Data.List.NonEmpty (NonEmpty)
+
+import Utils.I18nSpec ()
+import Model.Types.FileSpec ()
+
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+
+import qualified Data.Aeson as Aeson
+
+import Control.Lens.Extras (is)
+
+import Utils.I18n
+
+
+instance Arbitrary WorkflowPayloadLabel where
+  arbitrary = genericArbitrary
+  shrink = genericShrink
+
+instance (Arbitrary fileid, Arbitrary userid, Typeable fileid, Typeable userid, Ord fileid, Arbitrary (FileField fileid)) => Arbitrary (WorkflowPayloadSpec fileid userid) where
+  arbitrary = oneof
+    [ WorkflowPayloadSpec <$> arbitrary @(WorkflowPayloadField fileid userid Text)
+    , WorkflowPayloadSpec <$> arbitrary @(WorkflowPayloadField fileid userid Scientific)
+    , WorkflowPayloadSpec <$> arbitrary @(WorkflowPayloadField fileid userid Bool)
+    , WorkflowPayloadSpec <$> arbitrary @(WorkflowPayloadField fileid userid Day)
+    , WorkflowPayloadSpec <$> arbitrary @(WorkflowPayloadField fileid userid (Set fileid))
+    , WorkflowPayloadSpec <$> arbitrary @(WorkflowPayloadField fileid userid userid)
+    , WorkflowPayloadSpec <$> arbitrary @(WorkflowPayloadField fileid userid WorkflowPayloadFieldReference)
+    , WorkflowPayloadSpec <$> arbitrary @(WorkflowPayloadField fileid userid (NonEmpty (WorkflowFieldPayloadW fileid userid)))
+    ]
+
+instance Arbitrary (WorkflowPayloadField fileid userid Text) where
+  arbitrary = WorkflowPayloadFieldText
+    <$> scale (`div` 2) arbitrary
+    <*> scale (`div` 2) arbitrary
+    <*> scale (`div` 2) arbitrary
+    <*> scale (`div` 2) arbitrary
+    <*> scale (`div` 2) arbitrary
+    <*> scale (`div` 2) arbitrary
+instance Arbitrary (WorkflowPayloadField fileid userid Scientific) where
+  arbitrary = WorkflowPayloadFieldNumber
+    <$> scale (`div` 2) arbitrary
+    <*> scale (`div` 2) arbitrary
+    <*> scale (`div` 2) arbitrary
+    <*> scale (`div` 2) arbitrary
+    <*> scale (`div` 2) arbitrary
+    <*> scale (`div` 2) arbitrary
+    <*> scale (`div` 2) arbitrary
+    <*> scale (`div` 2) arbitrary
+instance Arbitrary (WorkflowPayloadField fileid userid Bool) where
+  arbitrary = WorkflowPayloadFieldBool
+    <$> scale (`div` 2) arbitrary
+    <*> scale (`div` 2) arbitrary
+    <*> scale (`div` 2) arbitrary
+    <*> scale (`div` 2) arbitrary
+instance Arbitrary (WorkflowPayloadField fileid userid Day) where
+  arbitrary = WorkflowPayloadFieldDay
+    <$> scale (`div` 2) arbitrary
+    <*> scale (`div` 2) arbitrary
+    <*> scale (`div` 2) arbitrary
+    <*> scale (`div` 2) arbitrary
+instance (Arbitrary (FileField fileid)) => Arbitrary (WorkflowPayloadField fileid userid (Set fileid)) where
+  arbitrary = WorkflowPayloadFieldFile
+    <$> scale (`div` 2) arbitrary
+    <*> scale (`div` 2) arbitrary
+    <*> scale (`div` 2) arbitrary
+    <*> scale (`div` 2) arbitrary
+instance Arbitrary userid => Arbitrary (WorkflowPayloadField fileid userid userid) where
+  arbitrary = oneof
+    [ WorkflowPayloadFieldUser
+        <$> scale (`div` 2) arbitrary
+        <*> scale (`div` 2) arbitrary
+        <*> scale (`div` 2) arbitrary
+        <*> scale (`div` 2) arbitrary
+    , pure WorkflowPayloadFieldCaptureUser
+    ]
+instance Arbitrary (WorkflowPayloadField fileid userid WorkflowPayloadFieldReference) where
+  arbitrary = WorkflowPayloadFieldReference
+    <$> scale (`div` 2) arbitrary
+instance (Arbitrary fileid, Arbitrary userid, Typeable fileid, Typeable userid, Ord fileid, Arbitrary (FileField fileid)) => Arbitrary (WorkflowPayloadField fileid userid (NonEmpty (WorkflowFieldPayloadW fileid userid))) where
+  arbitrary = WorkflowPayloadFieldMultiple
+    <$> scale (`div` 2) arbitrary
+    <*> scale (`div` 2) arbitrary
+    <*> scale (`div` 2) arbitrary
+    <*> scale (`div` 2) arbitrary
+    <*> scale (`div` 2) arbitrary
+    <*> scale (`div` 2) arbitrary
+ 
+instance Arbitrary WorkflowGraphEdgeFormOrder where
+  arbitrary = genericArbitrary
+  shrink = genericShrink
+
+instance (Arbitrary fileid, Arbitrary userid, Typeable fileid, Typeable userid, Ord fileid, Ord userid, Ord (FileField fileid), Arbitrary (FileField fileid)) => Arbitrary (WorkflowGraphEdgeForm fileid userid) where
+  arbitrary = WorkflowGraphEdgeForm . Map.fromList . mapMaybe (\(l, s) -> (l, ) <$> fromNullable (Set.fromList . mapMaybe fromNullable $ map Map.fromList s)) <$> listOf ((,) <$> scale (`div` 2) arbitrary <*> scale (`div` 2) (listOf . scale (`div` 2) . listOf $ (,) <$> scale (`div` 2) arbitrary <*> scale (`div` 2) arbitrary))
+  shrink = genericShrink
+
+instance (Arbitrary fileid, Arbitrary userid, Ord fileid, Typeable userid, Typeable fileid) => Arbitrary (WorkflowFieldPayloadW fileid userid) where
+  arbitrary = oneof
+    [ WorkflowFieldPayloadW <$> arbitrary @(WorkflowFieldPayload fileid userid Text)
+    , WorkflowFieldPayloadW <$> arbitrary @(WorkflowFieldPayload fileid userid Scientific)
+    , WorkflowFieldPayloadW <$> arbitrary @(WorkflowFieldPayload fileid userid Bool)
+    , WorkflowFieldPayloadW <$> arbitrary @(WorkflowFieldPayload fileid userid Day)
+    , WorkflowFieldPayloadW <$> arbitrary @(WorkflowFieldPayload fileid userid (Set fileid))
+    , WorkflowFieldPayloadW <$> arbitrary @(WorkflowFieldPayload fileid userid userid)
+    ]
+
+instance (Arbitrary payload, IsWorkflowFieldPayload fileid userid payload) => Arbitrary (WorkflowFieldPayload fileid userid payload) where
+  arbitrary = review _WorkflowFieldPayload <$> arbitrary
+
+instance Arbitrary WorkflowScope' where
+  arbitrary = genericArbitrary
+
+
+spec :: Spec
+spec = do
+  describe "WorkflowPayloadSpec" $ do
+    it "json-roundtrips some examples" $ do
+      let roundtrip val = Aeson.eitherDecode (Aeson.encode val) `shouldBe` Right val
+
+      -- Generated tests that failed previously
+      roundtrip $ WorkflowPayloadSpec @FileReference @SqlBackendKey (WorkflowPayloadFieldNumber {wpfnLabel = I18n {i18nFallback = "\368366\901557\714616k", i18nFallbackLang = Nothing, i18nTranslations = Map.fromList [("",""),("Jak8","\125553E")]}, wpfnPlaceholder = Just (I18n {i18nFallback = "\303706\543092", i18nFallbackLang = Nothing, i18nTranslations = Map.fromList []}), wpfnTooltip = Nothing, wpfnDefault = Nothing, wpfnMin = Nothing, wpfnMax = Just 0.1, wpfnStep = Nothing, wpfnOptional = False})
+  
+  describe "WorkflowGraphEdgeForm" $ do
+    it "json-decodes some examples" $ do
+      let decodes bs = Aeson.decode bs `shouldSatisfy` is (_Just @(WorkflowGraphEdgeForm FileReference SqlBackendKey))
+      
+      decodes "{\"\": [{\"tag\": \"capture-user\"}]}"
+      decodes "{\"\": [{\"_\": {\"tag\": \"capture-user\"}}]}"
+      decodes "{\"\": [{\"1\": {\"tag\": \"capture-user\"}}]}"
+      decodes "{\"\": [{\"-1\": {\"tag\": \"capture-user\"}}]}"
+      decodes "{\"\": [{\"tag\": \"capture-user\"}, {\"_\": {\"tag\": \"capture-user\"}}]}"
+      decodes "{\"\": [{\"tag\": \"capture-user\"}, {\"1\": {\"tag\": \"capture-user\"}}]}"
+      decodes "{\"\": [{\"_\": {\"tag\": \"capture-user\"}}, {\"1\": {\"tag\": \"capture-user\"}}]}"
+      decodes "{\"\": [{\"0.1\":{\"tag\": \"capture-user\"}}, {\"-0.1\":{\"tag\": \"capture-user\"}}]}"
+
+  parallel $ do
+    lawsCheckHspec (Proxy @WorkflowGraphEdgeFormOrder)
+      [ eqLaws, ordLaws, semigroupLaws, monoidLaws, semigroupMonoidLaws, commutativeSemigroupLaws, idempotentSemigroupLaws, showLaws, showReadLaws, jsonLaws, jsonKeyLaws ]
+    lawsCheckHspec (Proxy @(WorkflowPayloadSpec FileReference SqlBackendKey))
+      [ eqLaws, ordLaws, jsonLaws ]
+    modifyMaxSize (`div` 4) $ lawsCheckHspec (Proxy @(WorkflowGraphEdgeForm FileReference SqlBackendKey))
+      [ eqLaws, ordLaws, jsonLaws ]
+    lawsCheckHspec (Proxy @WorkflowScope')
+      [ eqLaws, ordLaws, boundedEnumLaws, showLaws, showReadLaws, universeLaws, finiteLaws, pathPieceLaws, jsonLaws, persistFieldLaws, binaryLaws ]
--- a/test/Model/TypesSpec.hs
+++ b/test/Model/TypesSpec.hs
@ -1,6 +1,8 @@
 {-# LANGUAGE UndecidableInstances #-}

-module Model.TypesSpec where
+module Model.TypesSpec
+  ( module Model.TypesSpec
+  ) where

 import TestImport
 import Settings
@ -17,9 +19,6 @@ import Yesod.Auth.Util.PasswordStore

 import Database.Persist.Sql (SqlBackend, fromSqlKey, toSqlKey)

-import Text.Blaze.Html
-import Text.Blaze.Renderer.Text
-
 import qualified Data.Set as Set

 import Network.IP.Addr
@ -39,9 +38,10 @@ import qualified Data.ByteString.Lazy as LBS

 import qualified Data.CaseInsensitive as CI

+import Model.Types.WorkflowSpec as Model.TypesSpec ()
+
+import Text.Blaze.TestInstances ()

-instance (Arbitrary a, MonoFoldable a) => Arbitrary (NonNull a) where
-  arbitrary = arbitrary `suchThatMap` fromNullable

 instance Arbitrary Season where
  arbitrary = genericArbitrary
@ -211,10 +211,6 @@ instance {-# OVERLAPPABLE #-} ToBackendKey SqlBackend record => Arbitrary (Key r
  arbitrary = toSqlKey <$> arbitrary
  shrink = map toSqlKey . shrink . fromSqlKey

-instance Arbitrary Html where
-  arbitrary = (preEscapedToHtml :: String -> Html) . getPrintableString <$> arbitrary
-  shrink = map preEscapedToHtml . shrink . renderMarkup
-
 instance Arbitrary OccurrenceSchedule where
  arbitrary = genericArbitrary
  shrink = genericShrink
--- a/test/ModelSpec.hs
+++ b/test/ModelSpec.hs
@ -24,9 +24,6 @@ import qualified Data.Char as Char

 import Utils

-import System.FilePath
-import Data.Time
-
 import Data.CryptoID.Poly
 import qualified Data.CryptoID.Class.ImplicitNamespace as Implicit

@ -34,11 +31,6 @@ import Control.Monad.Catch.Pure (Catch, runCatch)

 import System.IO.Unsafe (unsafePerformIO)

-import Data.Conduit
-import qualified Data.Conduit.Combinators as C
-
-import Data.Ratio ((%))
-
 import Data.Universe


@ -144,31 +136,6 @@ instance Arbitrary User where
    return User{..}
  shrink = genericShrink

-instance (LazySequence lazy strict, Arbitrary lazy, Monad m) => Arbitrary (ConduitT () strict m ()) where
-  arbitrary = C.sourceLazy <$> arbitrary
-
-scaleRatio :: Rational -> Int -> Int
-scaleRatio r = ceiling . (* r) . fromIntegral
-
-instance Monad m => Arbitrary (File m) where
-  arbitrary = do
-    fileTitle <- scale (scaleRatio $ 1 % 8) $ (joinPath <$> arbitrary) `suchThat` (any $ not . isPathSeparator)
-    date <- addDays <$> arbitrary <*> pure (fromGregorian 2043 7 2)
-    fileModified <- (addUTCTime <$> arbitrary <*> pure (UTCTime date 0)) `suchThat` inZipRange
-    fileContent <- oneof
-      [ pure Nothing
-      , Just <$> scale (scaleRatio $ 7 % 8) arbitrary
-      ]
-    return File{..}
-    where
-      inZipRange :: UTCTime -> Bool
-      inZipRange time
-        | time > UTCTime (fromGregorian 1980 1 1) 0
-        , time < UTCTime (fromGregorian 2107 1 1) 0
-        = True
-        | otherwise
-        = False
-
 instance Arbitrary ExamModePredicate where
  arbitrary = elements universeF

@ -208,8 +175,6 @@ spec = do
  parallel $ do
    lawsCheckHspec (Proxy @User)
      [ eqLaws, jsonLaws ]
-    lawsCheckHspec (Proxy @PureFile)
-      [ eqLaws, ordLaws ]
    lawsCheckHspec (Proxy @School)
      [ eqLaws ]
    lawsCheckHspec (Proxy @Term)
--- a/test/Test/QuickCheck/Classes/JSON.hs
+++ b/test/Test/QuickCheck/Classes/JSON.hs
@ -1,14 +1,15 @@
 module Test.QuickCheck.Classes.JSON
-  ( jsonKeyLaws
+  ( jsonLaws
+  , jsonKeyLaws
  ) where

 import ClassyPrelude
 import Test.QuickCheck
-import Test.QuickCheck.Property (failed)
-import Test.QuickCheck.Classes
+import Test.QuickCheck.Property (failed, Property(..))
+import Test.QuickCheck.Classes hiding (jsonLaws)
 import Data.Aeson
 import Data.Aeson.Encoding.Internal
-import Data.Aeson.Types (parseMaybe)
+import Data.Aeson.Types (parseEither)
 import Data.Proxy
 import Data.Coerce

@ -20,7 +21,7 @@ jsonKeyLaws _ = Laws "ToJSONKey/FromJSONKey"
        -> let (toVal, toEnc) = case toJSONKey of
                 ToJSONKeyText toVal' toEnc' -> (String . toVal', retagEncoding . toEnc')
                 ToJSONKeyValue toVal' toEnc' -> (toVal', toEnc')
-            in decode (encodingToLazyByteString $ toEnc a) == Just (toVal a)
+            in eitherDecode (encodingToLazyByteString $ toEnc a) == Right (toVal a)
    )
  ]
  where
@ -31,8 +32,40 @@ jsonKeyLaws _ = Laws "ToJSONKey/FromJSONKey"
      (ToJSONKeyText toVal _, FromJSONKeyText fromVal)
        -> property $ fromVal (toVal a) == a
      (ToJSONKeyText toVal _, FromJSONKeyTextParser parser)
-        -> property $ parseMaybe parser (toVal a) == Just a
+        -> property $ parseEither parser (toVal a) == Right a
      (ToJSONKeyValue toVal _, FromJSONKeyValue parser)
-        -> property $ parseMaybe parser (toVal a) == Just a
+        -> property $ parseEither parser (toVal a) == Right a
      (_, _)
        -> property failed
+
+jsonLaws :: (ToJSON a, FromJSON a, Show a, Arbitrary a, Eq a) => Proxy a -> Laws
+jsonLaws p = Laws "ToJSON/FromJSON"
+  [ ("Partial Isomorphism", jsonEncodingPartialIsomorphism p)
+  , ("Encoding Equals Value", jsonEncodingEqualsValue p)
+  ]
+
+-- TODO: improve the quality of the error message if
+-- something does not pass this test.
+jsonEncodingEqualsValue :: forall a. (ToJSON a, Show a, Arbitrary a) => Proxy a -> Property
+jsonEncodingEqualsValue _ = property $ \(a :: a) ->
+  case decode (encode a) of
+    Nothing -> False
+    Just (v :: Value) -> v == toJSON a
+
+jsonEncodingPartialIsomorphism :: forall a. (ToJSON a, FromJSON a, Show a, Eq a, Arbitrary a) => Proxy a -> Property
+jsonEncodingPartialIsomorphism _ = again $
+  MkProperty $
+    arbitrary >>= \(x :: a) ->
+      unProperty $
+      shrinking shrink x $ \x' ->
+        let desc1 = "Right"
+            desc2 = "Data.Aeson.eitherDecode . Data.Aeson.encode"
+            name1 = "Data.Aeson.encode a"
+            name2 = "Data.Aeson.eitherDecode (Data.Aeson.encode a)"
+            b1  = encode x'
+            b2  = eitherDecode b1
+            sb1 = show b1
+            sb2 = show b2
+            description = "  Description: " ++ desc1 ++ " == " ++ desc2
+            err = description ++ "\n" ++ unlines (map ("  " ++) (["a = " ++ show x'])) ++ "  " ++ name1 ++ " = " ++ sb1 ++ "\n  " ++ name2 ++ " = " ++ sb2
+        in counterexample err (Right x' == b2)
--- a/test/TestImport.hs
+++ b/test/TestImport.hs
@ -27,7 +27,7 @@ import Test.QuickCheck.Gen   as X
 import Data.Default          as X
 import Test.QuickCheck.Instances as X ()
 import Test.QuickCheck.Arbitrary.Generic as X
-import Test.QuickCheck.Classes as X
+import Test.QuickCheck.Classes as X hiding (jsonLaws)
 import Test.QuickCheck.Classes.PathPiece as X
 import Test.QuickCheck.Classes.PersistField as X
 import Test.QuickCheck.Classes.Hashable as X
--- a/test/TestInstances.hs
+++ b/test/TestInstances.hs
@ -0,0 +1,7 @@
+module TestInstances
+  (
+  ) where
+
+import Text.Blaze.TestInstances as TestInstances ()
+import Database.Persist.Sql.Types.TestInstances as TestInstances ()
+import Data.NonNull.TestInstances as TestInstances ()
--- a/test/Text/Blaze/TestInstances.hs
+++ b/test/Text/Blaze/TestInstances.hs
@ -0,0 +1,13 @@
+module Text.Blaze.TestInstances
+  (
+  ) where
+
+import TestImport
+
+import Text.Blaze.Html
+import Text.Blaze.Renderer.Text
+
+
+instance Arbitrary Html where
+  arbitrary = (preEscapedToHtml :: String -> Html) . getPrintableString <$> arbitrary
+  shrink = map preEscapedToHtml . shrink . renderMarkup
--- a/test/Utils/I18nSpec.hs
+++ b/test/Utils/I18nSpec.hs
@ -0,0 +1,18 @@
+module Utils.I18nSpec where
+
+import TestImport
+
+import Utils.I18n
+
+
+instance Arbitrary a => Arbitrary (I18n a) where
+  arbitrary = genericArbitrary
+  shrink = genericShrink
+
+spec :: Spec
+spec = do
+  parallel $ do
+    lawsCheckHspec (Proxy @I18nText)
+      [ eqLaws, ordLaws, showLaws, showReadLaws, jsonLaws, persistFieldLaws ]
+    lawsCheckHspec (Proxy @I18n)
+      [ foldableLaws, functorLaws, traversableLaws ]
--- a/testdata/exam-rooms.yaml
+++ b/testdata/exam-rooms.yaml
@ -1,30 +0,0 @@
-nodes:
-  "beantragt":
-    display-label: "Beantragt"
-    final: false
-    viewers:
-      - tag: initiator
-      - tag: authorized
-        authorized: { "dnf-terms": [[{"val": "variable", "var": "exam-office"}]] }
-    edges:
-      "beantragen":
-        mode: initial
-        display-label: "Beantragen"
-        actors:
-          - tag: authorized
-            authorized: { "dnf-terms": [[{"val": "variable", "var": "lecturer"}]] }
-        form:
-          "raumbeschreibung":
-            - tag: text
-              label: "Raumbeschreibung"
-              placeholder: null
-              tooltip: null
-              default: null
-              optional: false
-payload-view:
-  "raumbeschreibung":
-    display-label: "Raumbeschreibung"
-    viewers:
-      - tag: initiator
-      - tag: authorized
-        authorized: { "dnf-terms": [[{"val": "variable", "var": "exam-office"}]] }
--- a/testdata/theses.yaml
+++ b/testdata/theses.yaml
@ -1,112 +1,293 @@
 nodes:
  "antrag":
-    display-label: "Antrag angelegt"
-    final: false
    viewers:
-      - &pruefungsamt
-        tag: authorized
-        authorized: { "dnf-terms": [[{"val": "variable", "var": "exam-office"}]] }
-      - &hochschullehrer
-        tag: payload-reference
-        payload-label: "hochschullehrer"
-      - &betreuer
-        tag: payload-reference
-        payload-label: "betreuer"
-      - &student
-        tag: payload-reference
-        payload-label: "student"
+      display-label: "Antrag angelegt"
+      viewers:
+        - &pruefungsamt
+          tag: authorized
+          authorized: { "dnf-terms": [[{"tag": "variable", "var": "exam-office"}]] }
+        - &hochschullehrer
+          tag: payload-reference
+          payload-label: "hochschullehrer"
+        - &betreuer
+          tag: payload-reference
+          payload-label: "betreuer"
+        - &student
+          tag: payload-reference
+          payload-label: "student"
+    final: false
    edges:
      "antrag als pruefungsamt":
        mode: initial
        display-label: "Antrag anlegen (als Prüfungsverwaltung)"
        actors:
          - *pruefungsamt
-        form:
+        view-actor:
+          - *pruefungsamt
+        form: &antrag-forms-pruefungsamt
          "hochschullehrer": &hochschullehrer-form
-            - tag: multiple
-              label: "Verantwortliche Hochschullehrer"
-              tooltip: null
-              default: null
-              min: 1
-              range: null
-              sub:
-                tag: user
-                label: "Verantwortlicher Hochschullehrer"
+            - "1":
+                tag: multiple
+                label: "Verantwortliche Hochschullehrer"
                tooltip: null
                default: null
-                optional: false
+                min: 1
+                range: null
+                sub:
+                  tag: user
+                  label: "Verantwortlicher Hochschullehrer"
+                  tooltip: null
+                  default: null
+                  optional: false
          "betreuer": &betreuer-form
-            - tag: multiple
-              label: "Betreuer"
-              tooltip: null
-              default: null
-              min: 0
-              range: null
-              sub:
-                tag: user
+            - "2":
+                tag: multiple
                label: "Betreuer"
                tooltip: null
                default: null
-                optional: false
+                min: 0
+                range: null
+                sub:
+                  tag: user
+                  label: "Betreuer"
+                  tooltip: null
+                  default: null
+                  optional: false
          "student": &student-form
-            - tag: user
-              label: "Student"
-              tooltip: null
-              default: null
-              optional: false
+            - "3":
+                tag: user
+                label: "Student"
+                tooltip: null
+                default: null
+                optional: false
+          "anmeldetag": &anmeldetag-form-optional
+            - "4": &anmeldetag-field-optional
+                tag: day
+                label: "Tag der Anmeldung"
+                tooltip: null
+                default: null
+                optional: true
+          "sprache": &sprache-form-optional
+            - "5": &sprache-field-optional
+                tag: text
+                label: "Sprache der Arbeit"
+                tooltip: null
+                default: null
+                optional: true
+          "titel": &titel-form-optional
+            - "6": &titel-field-optional
+                tag: text
+                label: "Titel, in Sprache der Arbeit"
+                tooltip: null
+                default: null
+                optional: true
+          "titel, englisch": &entitel-form-optional
+            - "7": &entitel-field-optional
+                tag: text
+                label: "Titel, Englisch"
+                tooltip: null
+                default: null
+                optional: true
+          "aufgabenstellung": &aufgabenstellung-form
+            - "8":
+                tag: text
+                large: true
+                label: "Aufgabenstellung"
+                tooltip: null
+                default: null
+                optional: true
+          "notizen": &notizen-form
+            - "9":
+                tag: text
+                large: true
+                label: "Notizen"
+                tooltip: "Einsehbar für alle Beteiligten, außer den Studenten"
+                default: null
+                optional: true
+      "korrektur als pruefungsamt": &korrektur-pruefungsamt
+        mode: manual
+        display-label: "Antrag anpassen"
+        source: "antrag"
+        actors:
+          - *pruefungsamt
+        view-actor:
+          - *pruefungsamt
+        form: *antrag-forms-pruefungsamt
+      "korrektur als pruefungsamt, hochschullehrer":
+        <<: *korrektur-pruefungsamt
+        source: "antrag, hochschullehrer"
+      "korrektur als pruefungsamt, student":
+        <<: *korrektur-pruefungsamt
+        source: "antrag, student"
+      "korrektur als pruefungsamt, student&hochschullehrer":
+        <<: *korrektur-pruefungsamt
+        source: "antrag, student&hochschullehrer"
+      "korrektur als pruefungsamt, student&hochschullehrer&anmeldetag":
+        <<: *korrektur-pruefungsamt
+        source: "antrag, student&hochschullehrer, anmeldetag"
      "antrag als hochschullehrer":
        mode: initial
        display-label: "Antrag anlegen (als verantwortlicher Hochschullehrer)"
        actors:
          - tag: authorized
-            authorized: { "dnf-terms": [[{"val": "variable", "var": "lecturer" }]] }
-        form:
+            authorized: { "dnf-terms": [[{"tag": "variable", "var": "lecturer" }]] }
+        view-actor: &view-actor-all
+          - *pruefungsamt
+          - *hochschullehrer
+          - *betreuer
+          - *student
+        form: &antrag-forms-hochschullehrer
          "hochschullehrer":
-            - tag: capture-user
-            - tag: multiple
-              label: "Zusätzliche verantwortliche Hochschullehrer"
-              tooltip: null
-              default: null
-              min: 0
-              range: null
-              sub:
-                tag: user
-                label: "Verantwortlicher Hochschullehrer"
+            - "1":
+                tag: capture-user
+            - "1.1":
+                tag: multiple
+                label: "Zusätzliche verantwortliche Hochschullehrer"
                tooltip: null
                default: null
-                optional: false
+                min: 0
+                range: null
+                sub:
+                  tag: user
+                  label: "Verantwortlicher Hochschullehrer"
+                  tooltip: null
+                  default: null
+                  optional: false
          "betreuer": *betreuer-form
          "student": *student-form
+          "anmeldetag": *anmeldetag-form-optional
+          "sprache": *sprache-form-optional
+          "titel": *titel-form-optional
+          "titel, englisch": *entitel-form-optional
+          "aufgabenstellung": *aufgabenstellung-form
+          "notizen": *notizen-form
+      "korrektur als hochschullehrer": &korrektur-hochschullehrer
+        mode: manual
+        display-label: "Antrag anpassen"
+        source: "antrag"
+        actors:
+          - *hochschullehrer
+        view-actor: *view-actor-all
+        form: *antrag-forms-hochschullehrer
+      "korrektur als hochschullehrer, student":
+        <<: *korrektur-hochschullehrer
+        source: "antrag, student"
      "antrag als betreuer":
        mode: initial
        display-label: "Antrag anlegen (als Betreuer)"
        actors:
          - tag: authorized
-            authorized: { "dnf-terms": [[{"val": "variable", "var": "lecturer" }]] }
-        form:
+            authorized: { "dnf-terms": [[{"tag": "variable", "var": "lecturer" }]] }
+        view-actor: *view-actor-all
+        form: &antrag-forms-betreuer
          "betreuer":
-            - tag: capture-user
-            - tag: multiple
-              label: "Zusätzliche Betreuer"
-              tooltip: null
-              default: null
-              min: 0
-              range: null
-              sub:
-                tag: user
-                label: "Betreuer"
+            - "2":
+                tag: capture-user
+            - "2.1":
+                tag: multiple
+                label: "Zusätzliche Betreuer"
                tooltip: null
                default: null
-                optional: false
+                min: 0
+                range: null
+                sub:
+                  tag: user
+                  label: "Betreuer"
+                  tooltip: null
+                  default: null
+                  optional: false
          "hochschullehrer": *hochschullehrer-form
          "student": *student-form
+          "anmeldetag": *anmeldetag-form-optional
+          "sprache": *sprache-form-optional
+          "titel": *titel-form-optional
+          "titel, englisch": *entitel-form-optional
+          "aufgabenstellung": *aufgabenstellung-form
+          "notizen": *notizen-form
+      "betreuer als hochschullehrer": &betreuer-hochschullehrer
+        mode: manual
+        display-label: "Eigene Rolle zu Betreuer wechseln"
+        source: "antrag"
+        actors:
+          - *hochschullehrer
+        view-actor: *view-actor-all
+        form: *antrag-forms-betreuer
+      "betreuer als hochschullehrer, student":
+        <<: *betreuer-hochschullehrer
+        source: "antrag, student"
+      "betreuer als hochschullehrer, hochschullehrer":
+        <<: *betreuer-hochschullehrer
+        source: "antrag, hochschullehrer"
+      "betreuer als hochschullehrer, student&hochschullehrer":
+        <<: *betreuer-hochschullehrer
+        source: "antrag, student&hochschullehrer"
+      "betreuer als hochschullehrer, student&hochschullehrer&anmeldetag":
+        <<: *betreuer-hochschullehrer
+        source: "antrag, student&hochschullehrer, anmeldetag"
+      "hochschullehrer als betreuer": &hochschullehrer-betreuer
+        mode: manual
+        display-label: "Eigene Rolle zu Hochschullehrer wechseln"
+        source: "antrag"
+        actors:
+          - *betreuer
+        view-actor: *view-actor-all
+        form: *antrag-forms-hochschullehrer
+      "hochschullehrer als betreuer, hochschullehrer":
+        <<: *hochschullehrer-betreuer
+        source: "antrag, hochschullehrer"
+      "hochschullehrer als betreuer, student":
+        <<: *hochschullehrer-betreuer
+        source: "antrag, student"
+      "hochschullehrer als betreuer, student&hochschullehrer":
+        <<: *hochschullehrer-betreuer
+        source: "antrag, student&hochschullehrer"
+      "hochschullehrer als betreuer, student&hochschullehrer&anmeldetag":
+        <<: *hochschullehrer-betreuer
+        source: "antrag, student&hochschullehrer, anmeldetag"
+      "korrektur als betreuer": &korrektur-betreuer
+        mode: manual
+        display-label: "Antrag anpassen"
+        source: "antrag"
+        actors:
+          - *betreuer
+        view-actor: *view-actor-all
+        form: *antrag-forms-betreuer
+      "korrektur als betreuer, student":
+        <<: *korrektur-betreuer
+        source: "antrag, student"
+      "korrektur als betreuer, hochschullehrer":
+        <<: *korrektur-betreuer
+        source: "antrag, hochschullehrer"
+      "korrektur als betreuer, student&hochschullehrer":
+        <<: *korrektur-betreuer
+        source: "antrag, student&hochschullehrer"
+      "korrektur als betreuer, student&hochschullehrer&anmeldetag":
+        <<: *korrektur-betreuer
+        source: "antrag, student&hochschullehrer, anmeldetag"
+      "korrektur als student": &korrektur-student
+        mode: manual
+        display-label: "Antrag anpassen"
+        source: "antrag"
+        actors:
+          - *student
+        view-actor: *view-actor-all
+        form:
+          "sprache": *sprache-form-optional
+          "titel": *titel-form-optional
+          "titel, englisch": *entitel-form-optional
+          "aufgabenstellung": *aufgabenstellung-form
+      "korrektur als student, hochschullehrer":
+        <<: *korrektur-student
+        source: "antrag, hochschullehrer"
+       
  "antrag, hochschullehrer":
-    display-label: "Antrag angelegt und vom Hochschullehrer bestätigt"
-    final: false
    viewers:
-      - *pruefungsamt
-      - *hochschullehrer
-      - *betreuer
+      display-label: "Antrag angelegt und vom Hochschullehrer bestätigt"
+      viewers:
+        - *pruefungsamt
+        - *hochschullehrer
+        - *betreuer
+    final: false
    edges:
      "antrag bestaetigen als hochschullehrer":
        mode: manual
@ -115,15 +296,26 @@ nodes:
        actors:
          - *hochschullehrer
          - *pruefungsamt
+        view-actor: *view-actor-all
        form: {}
+      "korrektur als hochschullehrer":
+        <<: *korrektur-hochschullehrer
+        source: "antrag, hochschullehrer"
+      "korrektur als hochschullehrer, student":
+        <<: *korrektur-hochschullehrer
+        source: "antrag, student&hochschullehrer"
+      "korrektur als hochschullehrer, student&anmeldetag":
+        <<: *korrektur-hochschullehrer
+        source: "antrag, student&hochschullehrer, anmeldetag"
  "antrag, student":
-    display-label: "Antrag angelegt und vom Student bestätigt"
-    final: false
    viewers:
-      - *pruefungsamt
-      - *student
-      - *hochschullehrer
-      - *betreuer
+      display-label: "Antrag angelegt und vom Student bestätigt"
+      viewers:
+        - *pruefungsamt
+        - *student
+        - *hochschullehrer
+        - *betreuer
+    final: false
    edges:
      "antrag bestaetigen als student":
        mode: manual
@ -132,14 +324,25 @@ nodes:
        actors:
          - *student
          - *pruefungsamt
+        view-actor: *view-actor-all
        form: {}
+      "korrektur als student":
+        <<: *korrektur-student
+        source: "antrag, student"
+      "korrektur als student, hochschullehrer":
+        <<: *korrektur-student
+        source: "antrag, student&hochschullehrer"
+      "korrektur als student, hochschullehrer&anmeldetag":
+        <<: *korrektur-student
+        source: "antrag, student&hochschullehrer, anmeldetag"
  "antrag, student&hochschullehrer":
-    display-label: "Antrag angelegt und von Student und Hochschullehrer bestätigt"
-    final: false
    viewers:
-      - *pruefungsamt
-      - *hochschullehrer
-      - *betreuer
+      display-label: "Antrag angelegt und von Student und Hochschullehrer bestätigt"
+      viewers:
+        - *pruefungsamt
+        - *hochschullehrer
+        - *betreuer
+    final: false
    edges:
      "antrag bestaetigen als student":
        mode: manual
@ -148,6 +351,7 @@ nodes:
        actors:
          - *student
          - *pruefungsamt
+        view-actor: *view-actor-all
        form: {}
      "antrag bestaetigen als hochschullehrer":
        mode: manual
@ -156,86 +360,187 @@ nodes:
        actors:
          - *hochschullehrer
          - *pruefungsamt
+        view-actor: *view-actor-all
        form: {}
-  "angemeldet":
-    display-label: "Angemeldet"
-    final: false
+  "antrag, student&hochschullehrer, anmeldetag":
    viewers:
-      - *pruefungsamt
-      - *hochschullehrer
-      - *betreuer
-      - *student
+      display-label: "Antrag angelegt, von Student und Hochschullehrer bestätigt, Anmeldetag eingetragen"
+      viewers:
+        - *pruefungsamt
+        - *hochschullehrer
+        - *betreuer
+    final: false
    edges:
+      "anmeldetag ist eingetragen":
+        mode: automatic
+        source: "antrag, student&hochschullehrer"
+        payload-restriction: { "dnf-terms": [[{"tag": "variable", "var": "anmeldetag"}]] }
+  "angemeldet":
+    viewers:
+      display-label: "Angemeldet"
+      viewers:
+        - *pruefungsamt
+        - *hochschullehrer
+        - *betreuer
+        - *student
+    final: false
+    edges:
+      "anmelden, bestaetigt student&hochschullehrer, anmeldetag":
+        mode: manual
+        display-label: "Arbeit anmelden (bestätigt vom Student und verantwortlichem Hochschullehrer)"
+        source: "antrag, student&hochschullehrer, anmeldetag"
+        actors:
+          - *pruefungsamt
+        view-actor:
+          - *pruefungsamt
+        form: {}
      "anmelden, bestaetigt student&hochschullehrer":
        mode: manual
        display-label: "Arbeit anmelden (bestätigt vom Student und verantwortlichem Hochschullehrer)"
        source: "antrag, student&hochschullehrer"
        actors:
          - *pruefungsamt
+        view-actor:
+          - *pruefungsamt
        form:
-          "hochschullehrer": *hochschullehrer-form
-          "betreuer": *betreuer-form
-          "student": *student-form
+          "anmeldetag":
+            - "4":
+                <<: *anmeldetag-field-optional
+                optional: false
      "anmelden, bestaetigt student":
        mode: manual
        display-label: "Arbeit anmelden (bestätigt nur vom Student)"
        source: "antrag, student"
        actors:
          - *pruefungsamt
+        view-actor:
+          - *pruefungsamt
        form:
-          "hochschullehrer": *hochschullehrer-form
-          "betreuer": *betreuer-form
-          "student": *student-form
+          "anmeldetag":
+            - "4":
+                <<: *anmeldetag-field-optional
+                optional: false
      "anmelden, bestaetigt hochschullehrer":
        mode: manual
        display-label: "Arbeit anmelden (bestätigt nur vom Hochschullehrer)"
        source: "antrag, hochschullehrer"
        actors:
          - *pruefungsamt
+        view-actor:
+          - *pruefungsamt
        form:
-          "hochschullehrer": *hochschullehrer-form
-          "betreuer": *betreuer-form
-          "student": *student-form
+          "anmeldetag":
+            - "4":
+                <<: *anmeldetag-field-optional
+                optional: false
  "datei":
-    display-label: "Datei hochgeladen"
-    final: false
    viewers:
-      - *pruefungsamt
-      - *hochschullehrer
-      - *betreuer
-      - *student
+      display-label: "Datei hochgeladen"
+      viewers:
+        - *pruefungsamt
+        - *hochschullehrer
+        - *betreuer
+        - *student
+    final: false
    edges: {}
  "abgegeben":
-    display-label: "Abgabe akzeptiert"
-    final: false
    viewers:
-      - *pruefungsamt
-      - *hochschullehrer
-      - *betreuer
-      - *student
+      display-label: "Abgabe akzeptiert"
+      viewers:
+        - *pruefungsamt
+        - *hochschullehrer
+        - *betreuer
+        - *student
+    final: false
    edges: {}
  "benotet":
-    display-label: "Benotet"
-    final: false
    viewers:
-      - *pruefungsamt
-      - *hochschullehrer
-      - *betreuer
-      - *student
+      display-label: "Benotet"
+      viewers:
+        - *pruefungsamt
+        - *hochschullehrer
+        - *betreuer
+        - *student
+    final: false
    edges: {}
  "abgebrochen":
-    display-label: "Abgebrochen"
+    viewers:
+      display-label: "Abgebrochen"
+      viewers:
+        - *pruefungsamt
+        - *hochschullehrer
+        - *betreuer
+        - *student
    final: false
+    edges: {}
+  "fertig":
+    viewers:
+      display-label: "Fertig"
+      viewers:
+        - *pruefungsamt
+    final: true
+    edges: {}
+payload-view:
+  "hochschullehrer":
    viewers:
      - *pruefungsamt
      - *hochschullehrer
      - *betreuer
      - *student
-    edges: {}
-  "fertig":
-    display-label: "Fertig"
-    final: true
+      - {"tag": "initiator"}
+    display-label: "Verantwortliche Hochschullehrer"
+  "betreuer":
    viewers:
      - *pruefungsamt
-    edges: {}
-payload-view: {}
+      - *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"