diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg index a32cbe7d2..4299fdf8a 100644 --- a/messages/uniworx/de-de-formal.msg +++ b/messages/uniworx/de-de-formal.msg @@ -3129,3 +3129,8 @@ RoomReferenceLinkInstructionsPlaceholder: Anweisungen RoomReferenceNone: — UrlFieldCouldNotParseAbsolute: Konnte nicht als absolute URL interpretiert werden + +WGFTextInput: Textfeld +WGFFileUpload: Dateifeld +WorkflowGraphFormUploadIsDirectory: Upload ist Verzeichnis +WorkflowGraphFormInvalidNumberOfFiles: Es muss genau eine Datei hochgeladen werden \ No newline at end of file diff --git a/messages/uniworx/en-eu.msg b/messages/uniworx/en-eu.msg index 21911ad37..ec78e0e99 100644 --- a/messages/uniworx/en-eu.msg +++ b/messages/uniworx/en-eu.msg @@ -3129,3 +3129,8 @@ RoomReferenceLinkInstructionsPlaceholder: Instructions RoomReferenceNone: — UrlFieldCouldNotParseAbsolute: Could not parse as an absolute URL + +WGFTextInput: Text field +WGFFileUpload: File field +WorkflowGraphFormUploadIsDirectory: Upload is a directory +WorkflowGraphFormInvalidNumberOfFiles: You need to upload exactly one file diff --git a/src/Handler/Utils/Workflow/Form.hs b/src/Handler/Utils/Workflow/Form.hs index 5610d5b44..8c9ce7acc 100644 --- a/src/Handler/Utils/Workflow/Form.hs +++ b/src/Handler/Utils/Workflow/Form.hs @@ -30,6 +30,12 @@ import qualified Data.Aeson as JSON import Utils.Workflow.Lint +import qualified Data.Yaml as Yaml + +import Control.Monad.Catch.Pure (runCatch) + +import Handler.Utils.Files (sourceFile) + newtype FileIdent = FileIdent (CI Text) deriving (Eq, Ord, Read, Show, Generic, Typeable) @@ -93,12 +99,47 @@ data WorkflowGraphForm = WorkflowGraphForm makeLenses_ ''WorkflowGraphForm +data WorkflowGraphFormMode = WGFTextInput | WGFFileUpload + deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable) + deriving anyclass (Universe, Finite) +nullaryPathPiece ''WorkflowGraphFormMode $ camelToPathPiece' 1 +embedRenderMessage ''UniWorX ''WorkflowGraphFormMode id + workflowGraphForm :: Maybe WorkflowGraphForm -> AForm DB WorkflowGraphForm workflowGraphForm template = validateAForm validateWorkflowGraphForm . hoistAForm lift $ WorkflowGraphForm - <$> areq yamlField (fslI MsgWorkflowDefinitionGraph) (wgfGraph <$> template) + <$> multiActionA (mapF wgfGraphOptions) (fslI MsgWorkflowDefinitionGraph) (Just WGFFileUpload) <*> filesForm where + wgfGraphOptions = \case + WGFTextInput -> apreq yamlField (fslI MsgWorkflowDefinitionGraph) (wgfGraph <$> template) + WGFFileUpload -> apreq (checkMMap toGraph fromGraph . singleFileField . foldMap fromGraph $ wgfGraph <$> template) (fslI MsgWorkflowDefinitionGraph) (wgfGraph <$> template) + where + toGraph :: FileUploads -> Handler (Either (SomeMessage UniWorX) (WorkflowGraph FileIdent CryptoUUIDUser)) + toGraph uploads = runExceptT $ do + fRefs <- lift . runConduit $ uploads .| C.take 2 .| C.foldMap pure + fRef <- case fRefs of + [fRef] -> return fRef + _other -> throwE $ SomeMessage MsgWorkflowGraphFormInvalidNumberOfFiles + mContent <- for (fileContent $ sourceFile fRef) $ \fContent -> lift . runDB . runConduit $ fContent .| C.fold + content <- case mContent of + Nothing -> throwE $ SomeMessage MsgWorkflowGraphFormUploadIsDirectory + Just c -> return c + either (throwE . SomeMessage . MsgYAMLFieldDecodeFailure . displayException) return . runCatch $ Yaml.decodeThrow content + fromGraph :: WorkflowGraph FileIdent CryptoUUIDUser -> FileUploads + fromGraph g = yieldM . runDB $ do + fileModified <- liftIO getCurrentTime + fRef <- sinkFile $ File + { fileTitle = "graph.yaml" + , fileContent = Just . yield $ Yaml.encode g + , fileModified + } + insert_ SessionFile + { sessionFileContent = fileReferenceContent fRef + , sessionFileTouched = fileReferenceModified fRef + } + return fRef + filesForm = Map.fromList <$> massInputAccumEditA fileAdd fileEdit (const Nothing) fileLayout ("workflow-definition-files" :: Text) (fslI MsgWorkflowDefinitionFiles) False (Map.toList . wgfFiles <$> template) where fileAdd nudge submitView csrf = do (formRes, formView) <- fileForm nudge Nothing csrf