module Handler.Utils.Workflow.EdgeForm
  ( WorkflowEdgeForm(..)
  , workflowEdgeForm, WorkflowEdgeFormException(..)
  , workflowEdgeFormToAction
  ) where

import Import hiding (StateT)

import Utils.Form
import Utils.Workflow
import Handler.Utils.Form
import Handler.Utils.Workflow.CanonicalRoute
import Handler.Utils.Widgets
import Handler.Utils.Workflow.Restriction

import qualified ListT

import Data.RFC5051 (compareUnicode)
import qualified Data.Text as Text
import Text.Unidecode (unidecode)

import qualified Data.Map as Map
import Data.Map ((!), (!?))
import qualified Data.Set as Set
import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap

import qualified Crypto.MAC.KMAC as Crypto
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 Control.Monad.State.Class as State
import Control.Monad.Trans.RWS.Lazy (runRWST, mapRWST)
import Control.Monad.Trans.State.Strict (execState, evalStateT)
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

import Numeric.Lens (subtracting)

import qualified Data.Conduit.Combinators as C

import qualified Database.Esqueleto as E

import qualified Topograph

import qualified Text.Blaze as Blaze
import qualified Text.Blaze.Renderer.Text as Blaze


{-# ANN module ("HLint: ignore Use newtype instead of data"::String) #-}


data WorkflowEdgeForm = WorkflowEdgeForm
  { wefEdge :: (WorkflowGraphNodeLabel, WorkflowGraphEdgeLabel)
  , wefPayload :: Map WorkflowPayloadLabel (Set (WorkflowFieldPayloadW FileReference UserId))
  }

data WorkflowEdgeFormException
  = WorkflowEdgeFormPayloadFieldReferenceCycle [WorkflowPayloadLabel]
  deriving (Eq, Ord, Read, Show, Generic, Typeable)
  deriving anyclass (Exception)

workflowEdgeForm :: ( MonadHandler m
                    , HandlerSite m ~ UniWorX
                    , MonadHandler m'
                    , HandlerSite m' ~ UniWorX
                    , MonadCatch m'
                    )
                 => Either WorkflowInstanceId WorkflowWorkflowId
                 -> Maybe WorkflowEdgeForm
                 -> SqlPersistT m' (Maybe (AForm m WorkflowEdgeForm))
workflowEdgeForm mwwId mPrev = runMaybeT $ do
  MsgRenderer mr <- getMsgRenderer

  ctx' <- bitraverse (MaybeT . getEntity) (MaybeT . getEntity) mwwId
  let (scope, graph) = case ctx of
        Left  WorkflowInstance{..} -> ( _DBWorkflowScope # workflowInstanceScope
                                      , _DBWorkflowGraph # workflowInstanceGraph
                                      )
        Right WorkflowWorkflow{..} -> ( _DBWorkflowScope # workflowWorkflowScope
                                      , _DBWorkflowGraph # workflowWorkflowGraph
                                      )
      wState = ctx ^? _Right . _workflowWorkflowState . to last . _wpTo
      wPayload' = ctx ^? _Right . _workflowWorkflowState . re _DBWorkflowState 
      ctx = bimap entityVal entityVal ctx'
  mAuthId <- maybeAuthId
  wPayload <- case mwwId of
    Right wwId -> workflowStateCurrentPayloads <$> filterM (lift . hoist liftHandler . mayViewWorkflowAction mAuthId wwId) (maybe [] otoList wPayload')
    Left  _    -> return Map.empty

  rScope <- toRouteWorkflowScope scope

  -- edges :: [((WorkflowGraphNodeLabel, WorkflowGraphEdgeLabel), (I18nText, Map WorkflowPayloadLabel (NonNull (Set (WorkflowPayloadSpec FileReference UserId)))))]
  edges <- ListT.toList $ do
    (nodeLabel, WGN{..}) <- ListT.fromFoldable . Map.toList $ wgNodes graph
    (edgeLabel, edge) <- ListT.fromFoldable $ Map.toList wgnEdges
    ((nodeLabel, edgeLabel), ) <$> case edge of
      WorkflowGraphEdgeManual{..} -> do
        guard $ Just wgeSource == wState
        wwId <- hoistMaybe $ mwwId ^? _Right
        cID <- lift $ encrypt wwId
        guardM . anyM (Set.toList wgeActors) $ \role -> 
          lift . lift $ is _Authorized <$> hasWorkflowRole (Just wwId) role (_WorkflowScopeRoute # (rScope, WorkflowWorkflowR cID WWWorkflowR)) True
        return (wgeDisplayLabel, (wgeForm, wgeMessages))
      WorkflowGraphEdgeInitial{..}  -> do
        guard $ is _Nothing wState
        win <- hoistMaybe $ ctx ^? _Left . _workflowInstanceName
        guardM . anyM (Set.toList wgeActors) $ \role -> 
          lift . lift $ is _Authorized <$> hasWorkflowRole Nothing role (_WorkflowScopeRoute # (rScope, WorkflowInstanceR win WIInitiateR)) True
        return (wgeDisplayLabel, (wgeForm, wgeMessages))
      _other -> mzero

  guard . not $ null edges

  -- edgesOptList :: OptionList (WorkflowGraphNodeLabel, WorkflowGraphEdgeLabel)
  edgesOptList <- do
    sBoxKey <- secretBoxKey

    let olReadExternal ciphertext = do
          edgeIdent <- fromMaybeT . exceptTMaybe $ encodedSecretBoxOpen' sBoxKey ciphertext
          guard $ any (\(edgeIdent', _) -> edgeIdent == edgeIdent') edges
          return edgeIdent
    olOptions' <- ListT.toList $ do
      (edgeIdent, (edgeLabel, _)) <- ListT.fromFoldable edges
      optionDisplay <- lift $ selectLanguageI18n edgeLabel
      let optionInternalValue = edgeIdent
      optionExternalValue <- encodedSecretBox' sBoxKey SecretBoxShort edgeIdent
      return Option{..}
    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 . (mwwId, )
                        where toDigest :: Crypto.KMAC (SHAKE256 256) -> ByteString
                              toDigest = BA.convert
          opts <- sortBy optSort olOptions'
            & map (\opt@Option{..} -> (Text.concatMap (pack . unidecode) optionDisplay, opt))
            & foldr (\(k, v) -> InsOrdHashMap.insertWith (<>) k [v]) InsOrdHashMap.empty
            & InsOrdHashMap.elems
          
          if
            | [_] <- opts
              -> return opts
            | otherwise -> do
                return $ zipWith (\Option{..} i -> Option{ optionDisplay = mr $ MsgWorkflowEdgeNumberedVariant optionDisplay i, ..}) opts [1..]
    return OptionList{..}

  let edges' = flip sortOn edges $ \(edgeIdent, _) -> flip findIndex (olOptions edgesOptList) $ (== edgeIdent) . optionInternalValue

  let edgeForms :: Map (WorkflowGraphNodeLabel, WorkflowGraphEdgeLabel) (AForm Handler WorkflowEdgeForm)
      edgeForms = Map.fromList . flip map edges' $ \(edgeIdent@(tState, _), (_, (WorkflowGraphEdgeForm{..}, edgeMessages))) -> (edgeIdent, ) . fmap (WorkflowEdgeForm edgeIdent) . wFormToAForm . fmap sequenceA $ do
        forM_ edgeMessages $ \WorkflowEdgeMessage{..} -> void . runMaybeT $ do
          let hasWorkflowRole' role = liftHandler . runDB $ case ctx' of
                Right (Entity wwId _) -> do
                  cID <- encrypt wwId
                  is _Authorized <$> hasWorkflowRole (Just wwId) role (_WorkflowScopeRoute # (rScope, WorkflowWorkflowR cID WWWorkflowR)) True
                Left (Entity _ WorkflowInstance{..})
                  -> is _Authorized <$> hasWorkflowRole Nothing role (_WorkflowScopeRoute # (rScope, WorkflowInstanceR workflowInstanceName WIInitiateR)) True
          guardM $ anyM (otoList wemViewers) hasWorkflowRole'
          whenIsJust wemRestriction $ guard . checkWorkflowRestriction wPayload'
          let messageStatus = wemStatus
              messageIcon = Nothing
          messageContent <- selectLanguageI18n wemContent
          lift $ wformMessage Message{..}
        
        let fieldSort :: [(WorkflowPayloadLabel, [[(Either WorkflowGraphEdgeFormOrder ByteString, WorkflowPayloadSpec FileReference UserId)]])]
                      -> _
            fieldSort
              = sortOn ((,) <$> foldOf (_2 . folded . folded . _1 . _Left) <*> foldMapOf (_2 . folded . folded . _1 . _Right) (Just . Min))
              . over (traverse . _2) (sortOn $ (,) <$> foldOf (folded . _1 . _Left) <*> foldMapOf (folded . _1 . _Right) (Just . Min))
              . over (traverse . _2 . traverse) (sortOn $ (,) <$> preview (_1 . _Left) <*> preview (_1 . _Right))
        orderedFields <- lift . lift . fmap fieldSort . for (Map.toList wgefFields) $ \(payloadLabel, Set.toList . toNullable -> payloadSpecs) -> fmap (payloadLabel, ) . for payloadSpecs $ \(Map.toList . toNullable -> payloadSpecs') -> for payloadSpecs' $ \(payloadOrder, payloadSpec) -> if
          | payloadOrder /= mempty -> return (Left payloadOrder, payloadSpec)
          | otherwise -> do
              sBoxKey <- secretBoxKey
              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 (mwwId, payloadSpec')
              return (Right fallbackSortKey, payloadSpec)
              
        orderedFields' <- flip evalStateT 1 . for orderedFields $ \x@(payloadLabel, _) -> do
          let generateDisplayLabel = State.state $ \n -> (mr $ MsgWorkflowEdgeFormHiddenPayload n, succ n)
          (mayView, payloadDisplayLabel) <- hoist (lift . lift . runDB) . maybeT ((False, ) <$> generateDisplayLabel) $
            let
              displayNameFromState s = do
                WorkflowPayloadView{..} <- hoistMaybe . Map.lookup payloadLabel $ Map.findWithDefault Map.empty s (wgnPayloadView <$> wgNodes graph)
                wRoute <- case ctx' of
                  Right (Entity wwId _) -> do
                    cID <- encrypt wwId
                    return $ _WorkflowScopeRoute # (rScope, WorkflowWorkflowR cID WWWorkflowR)
                  Left (Entity _ WorkflowInstance{..})
                    -> return $ _WorkflowScopeRoute # (rScope, WorkflowInstanceR workflowInstanceName WIInitiateR)
                guardM . anyM (Set.toList $ toNullable wpvViewers) $ \role ->
                  lift . lift $ is _Authorized <$> hasWorkflowRole (mwwId ^? _Right) role wRoute False
                (True, ) <$> selectLanguageI18n wpvDisplayLabel
             in displayNameFromState tState <|> maybe mzero displayNameFromState wState
          return ((mayView, payloadDisplayLabel), x)

        fields <- for orderedFields' $ \((mayView, payloadDisplayLabel), (payloadLabel, payloadSpecs)) -> (payloadLabel, ) <$> do
          let payloadSpecs' = payloadSpecs ^.. folded . folded . _2
              payloadFields = workflowEdgePayloadFields payloadSpecs' $ fmap otoList . Map.lookup payloadLabel =<< prevSrc
                where prevSrc = asum
                        [ wefPayload <$> assertM ((== edgeIdent) . wefEdge) mPrev
                        , guardOn mayView wPayload
                        ]
          ((payloadRes, isOptional), payloadFieldViews) <- wFormFields payloadFields
          return ((payloadDisplayLabel, getAll isOptional), (payloadRes, payloadFieldViews))

        fields' <-
          let payloadReferenceAdjacency = fieldsMap <&> setOf (_2 . _1 . folded . _Left)
              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 (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
                      Left  ref -> Map.lookup ref oldState ^. _Just . _2 . _1
                 in Map.insert payloadLabel (payloadDisplay, (payloadRes', payloadFieldViews)) oldState
                where
                  topoOrder = map gFromVertex gVertices
                  resort = sortOn $ \(payloadLabel, _) -> findIndex (views _1 (== payloadLabel)) fields
           in either (throwM . WorkflowEdgeFormPayloadFieldReferenceCycle) return $ Topograph.runG payloadReferenceAdjacency resolveReferences

        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.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
              addErrMsg pErrs = Just
                [shamlet|
                  $newline never
                  $maybe errs <- pErrs
                    #{errs}
                    <br />
                  #{mr MsgWorkflowEdgeFormPayloadOneFieldRequired}
                |]
          case payloadFieldViews of
            [] -> return ()
            [fv] -> lift . tell . pure $ fv
                      & _fvRequired .~ not isOptional
                      & _fvErrors   %~ bool id addErrMsg doErrMsg
            _other -> do
              fvId <- newIdent
              let fvLabel = toHtml payloadDisplayLabel
                  fvTooltip = Nothing
                  fvInput = renderFieldViews FormWorkflowDataset $ payloadFieldViews
                              & traverse . _fvRequired .~ not isOptional
                  fvErrors = bool id addErrMsg doErrMsg Nothing
                  fvRequired = not isOptional
               in lift . tell $ pure FieldView{..}
          return payloadRes'

  return . hoistAForm liftHandler . multiActionAOpts edgeForms (return edgesOptList) actFS $ wefEdge <$> mPrev
  where
    actFS = fslI MsgWorkflowEdgeFormEdge

workflowEdgePayloadFields :: [WorkflowPayloadSpec FileReference UserId]
                          -> Maybe [WorkflowFieldPayloadW FileReference UserId]
                          -> 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 (NonEmpty (WorkflowFieldPayloadW FileReference UserId))))
    renderSpecField (WorkflowPayloadSpec (specField :: WorkflowPayloadField FileReference UserId payload)) = do
      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'
                         , State.MonadState [WorkflowFieldPayloadW FileReference UserId] m
                         )
                      => m (Maybe payload')
          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

      case specField of
        WorkflowPayloadFieldText{..} -> do
          prev <- extractPrev @Text
          wSetTooltip' (fmap slI18n wpftTooltip) $
            f wpftOptional
              (bool (textField & cfStrip) (textareaField & isoField _Wrapped & cfStrip) wpftLarge)
              ( fsl (slI18n wpftLabel)
                  & maybe id (addPlaceholder . slI18n) wpftPlaceholder
                  & maybe id (addName . ($ "text")) mNudge
              )
              (prev <|> wpftDefault)
        WorkflowPayloadFieldNumber{..} -> do
          prev <- extractPrev @Scientific
          wSetTooltip' (fmap slI18n wpfnTooltip) $
            f wpfnOptional
              ( fractionalField
                  & maybe id (\wpfnMin' -> checkBool (>= wpfnMin') $ MsgWorkflowEdgeFormFieldNumberTooSmall wpfnMin') wpfnMin
                  & maybe id (\wpfnMax' -> checkBool (>= wpfnMax') $ MsgWorkflowEdgeFormFieldNumberTooSmall wpfnMax') wpfnMax
                  & maybe id (\wpfnStep' -> flip convertField id . over (maybe id subtracting wpfnMin) $ \n -> fromInteger (round $ n / wpfnStep') * wpfnStep') wpfnStep
              )
              ( fsl (slI18n wpfnLabel)
                  & maybe id (addPlaceholder . slI18n) wpfnPlaceholder
                  & maybe id (addAttr "min" . tshow . formatScientific Scientific.Fixed Nothing) wpfnMin
                  & maybe id (addAttr "max" . tshow . formatScientific Scientific.Fixed Nothing) wpfnMax
                  & maybe (addAttr "step" "any") (addAttr "step" . tshow . formatScientific Scientific.Fixed Nothing) wpfnStep
                  & maybe id (addName . ($ "number")) mNudge
              )
              (prev <|> wpfnDefault)
        WorkflowPayloadFieldBool{..} -> do
          prev <- extractPrev @Bool
          wSetTooltip' (fmap slI18n wpfbTooltip) $
            f (is _Just wpfbOptional)
              (maybe checkBoxField (boolField . Just . SomeMessage . slI18n) wpfbOptional)
              ( fsl (slI18n wpfbLabel)
                  & 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 <- extractPrevs @FileReference $ \p -> if
            | fieldMultiple wpffConfig -> Just . maybe (Set.singleton p) (Set.insert p)
            | otherwise -> \case
                Nothing -> Just $ Set.singleton p
                Just _  -> Nothing
          let wpffConfig' = wpffConfig & _fieldAdditionalFiles %~ (fRefs' <>)
                where fRefs' = review _FileReferenceFileReferenceTitleMap . Map.fromList $ do
                        FileReference{..} <- Set.toList =<< hoistMaybe fRefs
                        return (fileReferenceTitle, (fileReferenceContent, fileReferenceModified, FileFieldUserOption False True))
          wSetTooltip' (fmap slI18n wpffTooltip) $
            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
              )
               fRefs
        WorkflowPayloadFieldUser{..} -> do
          fRefs <- extractPrev @UserId
          let suggestions uid = E.from $ \user -> do
                E.where_ $ user E.^. UserId E.==. E.val uid
                return user
          wSetTooltip' (fmap slI18n wpfuTooltip) $
            f wpfuOptional
              (checkMap (first $ const MsgWorkflowEdgeFormFieldUserNotFound) Right . userField False $ suggestions <$> fRefs)
              ( fslI (slI18n wpfuLabel)
                  & maybe id (addName . ($ "user")) mNudge
              )
              (fRefs <|> wpfuDefault)
        WorkflowPayloadFieldCaptureUser -> do
          mAuthId <- liftHandler maybeAuth
          case mAuthId of
            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 <- 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 (NonEmpty (WorkflowFieldPayloadW FileReference UserId))))
                mPrev = Just . Map.fromList . zip [0..] . ensureLength . map (\x -> (Just x, Just $ x :| [])) $ mPrev' ^.. _Just . folded
                  where
                    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 (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 . nonEmpty $ ress ^.. folded . _2 . _Just . folded)
                  Left res'
                    -> (False, res')
                runMI :: forall a.
                         WForm (ExceptT WorkflowPayloadLabel Handler) a
                      -> ExceptT WorkflowPayloadLabel (RWST (Maybe (Text -> Text)) All [WorkflowFieldPayloadW FileReference UserId] (MForm (WriterT [FieldView UniWorX] Handler))) a 
                runMI mx = do
                  r <- lift $ lift ask
                  s <- lift $ lift State.get
                  ((a, s', w), w') <- ExceptT . lift . lift . lift . runExceptT . runWriterT $ runRWST mx r s
                  lift . lift $ do
                    State.put s'
                    tell w
                    lift $ tell w'
                  lift . tell . All $ wpfmMin <= 0
                  return a

                miAdd :: ListPosition
                      -> Natural
                      -> (Text -> Text)
                      -> 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 $ over (mapped . _1 . _FormSuccess) tweakRes . miForm nudge (Left submitView)
                  where tweakRes :: Maybe (NonEmpty (WorkflowFieldPayloadW FileReference UserId))
                                 -> Map ListPosition (Maybe (WorkflowFieldPayloadW FileReference UserId))
                                 -> FormResult (Map ListPosition (Maybe (WorkflowFieldPayloadW FileReference UserId)))
                        tweakRes newDat prevData = pure . Map.fromList . zip [startKey..] . map Just $ newDat ^.. _Just . folded
                          where startKey = maybe 0 succ $ fst <$> Map.lookupMax prevData

                miCell :: ListPosition
                       -> Maybe (WorkflowFieldPayloadW FileReference UserId)
                       -> Maybe (Maybe (NonEmpty (WorkflowFieldPayloadW FileReference UserId)))
                       -> (Text -> Text)
                       -> (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 (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 (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 . folded)

                  let fFilled' = fFilled || isn't _FormSuccess fmRes
                      fmRes' | not fFilled' = FormFailure . pure . maybe (mr MsgValueRequired) (mr . valueRequired) $ fvs ^? _head . to fvLabel'
                             | otherwise    = fmRes
                      fvLabel' = toStrict . Blaze.renderMarkup . Blaze.contents . fvLabel -- Dirty, but probably good enough; if not: `censor` writer with actual `Text` in `renderSpecField` and discard that information in `workflowEdgePayloadFields`
                      fvs | not fFilled' = fvs' <&> \fv -> fv { fvErrors = Just
                                                                  [shamlet|
                                                                    $newline never
                                                                    $maybe errs <- fvErrors fv
                                                                      #{errs}
                                                                      <br />
                                                                    #{mr (valueRequired (fvLabel' fv))}
                                                                  |]
                                                               } 
                          | otherwise = fvs'
                      valueRequired :: forall msg. _ => msg -> ValueRequired UniWorX
                      valueRequired = ValueRequired

                  return ( fmRes'
                         , case mode of
                             Left  btn -> $(widgetFile "widgets/massinput/workflow-payload-field-multiple/add")
                             Right _   -> $(widgetFile "widgets/massinput/workflow-payload-field-multiple/cell")
                         )

                miDelete :: forall m.
                            Monad m
                         => Map ListPosition (Maybe (WorkflowFieldPayloadW FileReference UserId))
                         -> ListPosition
                         -> MaybeT m (Map ListPosition ListPosition)
                miDelete dat pos = do
                  ListLength l <- hoistMaybe . preview liveCoords $ Map.keysSet dat
                  guard $ l > wpfmMin
                  miDeleteList dat pos

                miAllowAdd :: ListPosition
                           -> Natural
                           -> ListLength
                           -> Bool
                miAllowAdd _ _ (ListLength l) = maybe True (l <) $ (+ wpfmMin) <$> wpfmRange

                miAddEmpty :: ListPosition
                           -> Natural
                           -> ListLength
                           -> Set ListPosition
                miAddEmpty _ _ _ = Set.empty

                miButtonAction :: forall p.
                                  p -> Maybe (SomeRoute UniWorX)
                miButtonAction _ = Nothing

                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


workflowEdgeFormToAction :: ( MonadHandler m
                            , HandlerSite m ~ UniWorX
                            )
                         => WorkflowEdgeForm
                         -> m (WorkflowAction FileReference UserId)
workflowEdgeFormToAction WorkflowEdgeForm{..} = do
    wpUser <- Just <$> maybeAuthId
    wpTime <- liftIO getCurrentTime
    return WorkflowAction{..}
  where
    (wpTo, wpVia) = wefEdge
    wpPayload = wefPayload