feat(admin-workflows): allow uploading graph spec as file

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

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

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