Clone files in questionnaire if copying questionnaire

Author: vknaisl

wizard-server/src/Wizard/Database/DAO/Questionnaire/QuestionnaireFileDAO.hs

@@ -92,8 +92,13 @@ findQuestionnaireFilesPage mQuery mQtnUuid pageable sort = do
             }
     return $ Page pageLabel metadata entities
 
-findQuestionnaireFilesByQuestionnaire :: U.UUID -> AppContextM [QuestionnaireFileSimple]
+findQuestionnaireFilesByQuestionnaire :: U.UUID -> AppContextM [QuestionnaireFile]
 findQuestionnaireFilesByQuestionnaire qtnUuid = do
+  tenantUuid <- asks currentTenantUuid
+  createFindEntitiesWithFieldsByFn "*" entityName [tenantQueryUuid tenantUuid, ("questionnaire_uuid", U.toString qtnUuid)]
+
+findQuestionnaireFilesSimpleByQuestionnaire :: U.UUID -> AppContextM [QuestionnaireFileSimple]
+findQuestionnaireFilesSimpleByQuestionnaire qtnUuid = do
   tenantUuid <- asks currentTenantUuid
   createFindEntitiesWithFieldsByFn "uuid, file_name, content_type, file_size" entityName [tenantQueryUuid tenantUuid, ("questionnaire_uuid", U.toString qtnUuid)]
 

wizard-server/src/Wizard/S3/Questionnaire/QuestionnaireFileS3.hs

@@ -21,6 +21,9 @@ retrieveFileConduitAction questionnaireUuid fileUuid = createGetObjectConduitAct
 putFile :: U.UUID -> U.UUID -> String -> BS.ByteString -> AppContextM String
 putFile questionnaireUuid fileUuid contentType = createPutObjectFn (f' "%s/%s/%s" [folderName, U.toString questionnaireUuid, U.toString fileUuid]) (Just contentType) Nothing
 
+putFileConduit :: U.UUID -> U.UUID -> String -> String -> Minio (C.ConduitM () BS.ByteString Minio ()) -> AppContextM String
+putFileConduit questionnaireUuid fileUuid contentType contentDisposition = createPutObjectConduitFn (f' "%s/%s/%s" [folderName, U.toString questionnaireUuid, U.toString fileUuid]) (Just contentType) (Just contentDisposition)
+
 presigneGetFileUrl :: U.UUID -> U.UUID -> Int -> AppContextM String
 presigneGetFileUrl questionnaireUuid fileUuid = createPresignedGetObjectUrl (f' "%s/%s/%s" [folderName, U.toString questionnaireUuid, U.toString fileUuid])
 

wizard-server/src/Wizard/Service/Document/Context/DocumentContextService.hs

@@ -64,7 +64,7 @@ createDocumentContext doc pkg branchEvents qtn mReplies = do
           (Just eventUuid) -> findQuestionnaireVersionUuid eventUuid qtn.versions
           _ -> Nothing
   qtnVersionDtos <- traverse enhanceQuestionnaireVersion qtn.versions
-  qtnFiles <- findQuestionnaireFilesByQuestionnaire doc.questionnaireUuid
+  qtnFiles <- findQuestionnaireFilesSimpleByQuestionnaire doc.questionnaireUuid
   (users, groups) <- heSettingsToPerms qtn
   return $
     toDocumentContext

wizard-server/src/Wizard/Service/Questionnaire/File/QuestionnaireFileService.hs

@@ -9,6 +9,7 @@ import Shared.Common.Model.Common.Page
 import Shared.Common.Model.Common.Pageable
 import Shared.Common.Model.Common.Sort
 import Shared.Common.Service.Acl.AclService
+import Shared.Common.Util.String
 import Shared.Common.Util.Uuid
 import Wizard.Api.Resource.File.FileCreateDTO
 import Wizard.Api.Resource.TemporaryFile.TemporaryFileDTO
@@ -55,6 +56,22 @@ createQuestionnaireFile qtnUuid questionUuid reqDto =
     addFile qtnUuid (toSimple qtnFile)
     return $ toList qtnFile qtn mCurrentUser
 
+cloneQuestionnaireFiles :: U.UUID -> U.UUID -> AppContextM [(QuestionnaireFile, QuestionnaireFile)]
+cloneQuestionnaireFiles oldQtnUuid newQtnUuid = do
+  runInTransaction $ do
+    oldFiles <- findQuestionnaireFilesByQuestionnaire oldQtnUuid
+    traverse
+      ( \oldFile -> do
+          contentAction <- retrieveFileConduitAction oldQtnUuid oldFile.uuid
+          newFileUuid <- liftIO generateUuid
+          let newFile = oldFile {uuid = newFileUuid, questionnaireUuid = newQtnUuid}
+          let contentDisposition = f' "attachment;filename=\"%s\"" [trim newFile.fileName]
+          insertQuestionnaireFile newFile
+          putFileConduit newQtnUuid newFile.uuid newFile.contentType contentDisposition contentAction
+          return (oldFile, newFile)
+      )
+      oldFiles
+
 downloadQuestionnaireFile :: U.UUID -> U.UUID -> AppContextM TemporaryFileDTO
 downloadQuestionnaireFile qtnUuid fileUuid = do
   runInTransaction $ do
@@ -67,7 +84,7 @@ downloadQuestionnaireFile qtnUuid fileUuid = do
 deleteQuestionnaireFilesByQuestionnaireUuid :: U.UUID -> AppContextM ()
 deleteQuestionnaireFilesByQuestionnaireUuid qtnUuid = do
   runInTransaction $ do
-    files <- findQuestionnaireFilesByQuestionnaire qtnUuid
+    files <- findQuestionnaireFilesSimpleByQuestionnaire qtnUuid
     checkEditPermissionToFile qtnUuid
     traverse_
       ( \file -> do

wizard-server/src/Wizard/Service/Questionnaire/QuestionnaireService.hs

@@ -55,7 +55,9 @@ import Wizard.Model.Questionnaire.QuestionnaireDetailQuestionnaire
 import Wizard.Model.Questionnaire.QuestionnaireDetailSettings
 import Wizard.Model.Questionnaire.QuestionnaireEvent
 import Wizard.Model.Questionnaire.QuestionnaireEventLenses ()
+import Wizard.Model.Questionnaire.QuestionnaireFile
 import Wizard.Model.Questionnaire.QuestionnairePerm
+import Wizard.Model.Questionnaire.QuestionnaireReply
 import Wizard.Model.Tenant.Config.TenantConfig
 import Wizard.S3.Document.DocumentS3
 import Wizard.Service.KnowledgeModel.KnowledgeModelService
@@ -178,13 +180,15 @@ createQuestionnaireFromTemplate reqDto =
             , updatedAt = now
             }
           :: Questionnaire
-    newQtnEvents <- cloneQuestinonaireEvents newQtnUuid originQtnEvents
     insertQuestionnaire newQtn
-    insertQuestionnaireEvents newQtnEvents
+    clonedFiles <- cloneQuestionnaireFiles originQtn.uuid newQtn.uuid
+    newQtnEvents <- cloneQuestinonaireEvents newQtnUuid originQtnEvents
+    let newQtnEventsWithReplacedFiles = replaceQuestinonaireEventsWithNewFiles clonedFiles newQtnEvents
+    insertQuestionnaireEvents newQtnEventsWithReplacedFiles
     duplicateCommentThreads reqDto.questionnaireUuid newQtnUuid
     state <- getQuestionnaireState newQtnUuid pkg.pId
     permissionDtos <- traverse enhanceQuestionnairePerm newQtn.permissions
-    qtnCtn <- compileQuestionnaire newQtnEvents
+    qtnCtn <- compileQuestionnaire newQtnEventsWithReplacedFiles
     return $ toSimpleDTO newQtn pkg state permissionDtos
 
 cloneQuestionnaire :: U.UUID -> AppContextM QuestionnaireDTO
@@ -209,9 +213,11 @@ cloneQuestionnaire cloneUuid =
             , updatedAt = now
             }
           :: Questionnaire
-    newQtnEvents <- cloneQuestinonaireEvents newQtnUuid originQtnEvents
     insertQuestionnaire newQtn
-    insertQuestionnaireEvents newQtnEvents
+    clonedFiles <- cloneQuestionnaireFiles originQtn.uuid newQtn.uuid
+    newQtnEvents <- cloneQuestinonaireEvents newQtnUuid originQtnEvents
+    let newQtnEventsWithReplacedFiles = replaceQuestinonaireEventsWithNewFiles clonedFiles newQtnEvents
+    insertQuestionnaireEvents newQtnEventsWithReplacedFiles
     duplicateCommentThreads cloneUuid newQtnUuid
     state <- getQuestionnaireState newQtnUuid pkg.pId
     permissionDtos <- traverse enhanceQuestionnairePerm newQtn.permissions
@@ -427,3 +433,20 @@ cloneQuestinonaireEvents newQtnUuid =
         newEventUuid <- liftIO generateUuid
         return $ setQuestionnaireUuid (setUuid event newEventUuid) newQtnUuid
     )
+
+replaceQuestinonaireEventsWithNewFiles :: [(QuestionnaireFile, QuestionnaireFile)] -> [QuestionnaireEvent] -> [QuestionnaireEvent]
+replaceQuestinonaireEventsWithNewFiles clonedFiles qtnEvents =
+  let findFile :: U.UUID -> Maybe (QuestionnaireFile, QuestionnaireFile)
+      findFile fileUuid = L.find (\(oldFile, newFile) -> oldFile.uuid == fileUuid) clonedFiles
+      replaceEvent :: QuestionnaireEvent -> QuestionnaireEvent
+      replaceEvent (SetReplyEvent' event) =
+        let value' =
+              case event.value of
+                r@FileReply {..} ->
+                  case findFile r.fValue of
+                    Just (oldFile, newFile) -> r {fValue = newFile.uuid}
+                    _ -> r
+                r -> r
+         in SetReplyEvent' (event {value = value'})
+      replaceEvent event' = event'
+   in fmap replaceEvent qtnEvents