45 lines
2.1 KiB
Haskell
45 lines
2.1 KiB
Haskell
module Handler.Workflow.Definition.Form
|
|
( WorkflowDefinitionForm(..)
|
|
, workflowDefinitionForm
|
|
, module Handler.Utils.Workflow.Form
|
|
) where
|
|
|
|
import Import
|
|
|
|
import Handler.Utils
|
|
import Handler.Utils.Workflow.Form
|
|
|
|
import qualified Data.CryptoID as C
|
|
|
|
|
|
data WorkflowDefinitionForm = WorkflowDefinitionForm
|
|
{ wdfScope :: WorkflowScope'
|
|
, wdfName :: WorkflowDefinitionName
|
|
, wdfInstanceCategory :: Maybe WorkflowInstanceCategory
|
|
, wdfDescriptions :: Map Lang (Text, Maybe StoredMarkup)
|
|
, wdfInstanceDescriptions :: Map Lang (Text, Maybe StoredMarkup)
|
|
, wdfGraph :: WorkflowGraphForm
|
|
} deriving (Generic, Typeable)
|
|
|
|
makeLenses_ ''WorkflowDefinitionForm
|
|
|
|
workflowDefinitionForm :: Maybe WorkflowDefinitionForm -> Html -> MForm DB (FormResult WorkflowDefinitionForm, Widget)
|
|
workflowDefinitionForm template = validateForm validateWorkflowDefinitionForm . renderAForm FormStandard $ WorkflowDefinitionForm
|
|
<$> apopt (hoistField lift $ selectField optionsFinite) (fslI MsgWorkflowDefinitionScope) (wdfScope <$> template)
|
|
<*> areq ciField (fslI MsgWorkflowDefinitionName) (wdfName <$> template)
|
|
<*> aopt ciField (fslI MsgWorkflowDefinitionInstanceCategory) (wdfInstanceCategory <$> template)
|
|
<*> hoistAForm lift (workflowDescriptionsForm WorkflowDescriptionsFormDefinition $ wdfDescriptions <$> template)
|
|
<*> hoistAForm lift (workflowDescriptionsForm WorkflowDescriptionsFormInstance $ wdfInstanceDescriptions <$> template)
|
|
<*> workflowGraphForm (wdfGraph <$> template)
|
|
|
|
validateWorkflowDefinitionForm :: FormValidator WorkflowDefinitionForm DB ()
|
|
validateWorkflowDefinitionForm = do
|
|
join . uses _wdfGraph . mapMOf_ (typesCustom @WorkflowChildren) . ensureExists $ Proxy @User
|
|
where
|
|
ensureExists :: forall record ns p r. _ => p record -> C.CryptoID ns UUID -> FormValidator r DB ()
|
|
ensureExists _ cID = maybeT (tellValidationError . MsgWorkflowUserDoesNotExist $ toPathPiece cID) . catchMPlus (Proxy @CryptoIDError) $ do
|
|
$logDebugS "validateWorkflowDefinitionForm" $ "Checking key for existence: " <> toPathPiece cID
|
|
key <- decrypt cID
|
|
guardM . lift . lift $ existsKey (key :: Key record)
|
|
|